123
返回列表 上一主題 發帖

利用VBA 表單製作萬年曆?

mark15jill
　暱稱: 隨風飄蕩的羽毛
　頭銜: [御用]潛水艇

高中生Rank: 3Rank: 3

帖子
852 
主題
79 
精華
0 
積分
918 
點名
0  
作業系統
Windows 7 , XP 
軟體版本
Office 2007, Office 2003,Office 2010,YoZo Office 
閱讀權限
50 
性別
男 
來自
宇宙 
註冊時間
2011-4-8 
最後登錄
2024-2-21 
11# 跳轉到 »
發表於 2013-3-26 12:02 | 只看該作者
回復 9# Jared

你這問題有可能是 循環內 你弄錯參數..

例如
k=1
for hwe = 1 to 31

    me.controls("optionbutton"& hwe ) = hwe

next

  多做多想多學習，少看少錯少迷途

  多做=多多練習，多多編寫。
  多想=想想為什麼人家程式要那樣寫，如果換成自己，又會怎寫。
  多學習=學習人家的發問並解答，學習人家的寫法

  少看=只看不做也枉然

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
12#
發表於 2013-3-26 13:24 | 只看該作者
回復 9# Jared
  1. 這個月的第一天    DateSerial(ComboBox1, ComboBox2, 1)
  2. 這個月的最後一天 DateSerial(ComboBox1, ComboBox2.Value + 1, 0)
複製代碼
修改 5# 檔案 表單程式碼 如下
  1. Option Explicit
  2. Dim Class_OB(1 To 7, 1 To 6) As New Class1
  3. Private Sub UserForm_Initialize()
  4.     Dim I As Integer
  5.      日期項
  6.     For I = 1980 To 2099
  7.         ComboBox1.AddItem I
  8.     Next
  9.     ComboBox1.Value = Year(Date)
  10.     For I = 1 To 12
  11.         ComboBox2.AddItem I
  12.     Next
  13.     ComboBox2.Value = Month(Date)
  14. End Sub
  15. Private Sub ComboBox1_Change()
  16.     月曆
  17. End Sub
  18. Private Sub ComboBox2_Change()
  19.     月曆
  20. End Sub
  21. Private Sub 月曆()
  22.    月曆清除
  23.     If ComboBox1.ListIndex > -1 And ComboBox2.ListIndex > -1 Then 萬年曆
  24. End Sub
  25. Private Sub 萬年曆()
  26.     Dim R As Integer, I As Date, WD As Integer
  27.      R = 1
  28.      For I = DateSerial(ComboBox1, ComboBox2, 1) To DateSerial(ComboBox1, ComboBox2.Value + 1, 0)
  29.         WD = Weekday(I)
  30.         With Controls(R & "_" & WD)
  31.             .Enabled = True
  32.             .Caption = Day(I)
  33.             .ControlTipText = I
  34.         End With
  35.         If WD = 7 Then R = R + 1
  36.      Next
  37. End Sub
  38. Private Sub 日期項()
  39.     Dim OBtop As Integer, OBLeft As Integer, R As Integer
  40.     Dim OB_1 As Integer, OB_2 As Integer
  41.     R = Label1.Top + 30
  42.       For OB_2 = 1 To UBound(Class_OB, 2)
  43.         For OB_1 = 1 To UBound(Class_OB, 1)
  44.             With Controls.Add("Forms.OptionButton.1", OB_2 & "_" & OB_1)
  45.                 .Visible = True
  46.                 .Top = R '
  47.                 .Left = Controls("Label" & OB_1).Left
  48.                 'Controls("Label" & OB_1)->已建立星期之 Label控制項
  49.                 '名稱依序為Label1,Label2,Label3,Label4,Label5,Label6,Label7.
  50.                 .Height = 15
  51.                 .Width = 30
  52.                 .ControlTipText = ""
  53.             End With
  54.             Set Class_OB(OB_1, OB_2).OB = Controls(OB_2 & "_" & OB_1)
  55.         Next
  56.         R = R + 30
  57.      Next
  58. End Sub
  59. Private Sub 月曆清除()
  60.     Dim E As Control
  61.     For Each E In Me.Controls
  62.         If E.Name Like "*_*" Then
  63.             E.Enabled = False
  64.             E.Caption = ""
  65.             E.ControlTipText = ""
  66.         End If
  67.     Next
  68. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

Jared

帖子
103 
主題
30 
精華
0 
積分
139 
點名
0  
作業系統
wondows XP 
軟體版本
office 2007 
閱讀權限
20 
性別
男 
來自
彰化 
註冊時間
2013-2-21 
最後登錄
2015-6-26 
13#
發表於 2013-3-26 14:09 | 只看該作者
回復 11# mark15jill


大大
後來發現運算式都錯了
計算出來的天數都不對....><
Jared

TOP

Jared

帖子
103 
主題
30 
精華
0 
積分
139 
點名
0  
作業系統
wondows XP 
軟體版本
office 2007 
閱讀權限
20 
性別
男 
來自
彰化 
註冊時間
2013-2-21 
最後登錄
2015-6-26 
14#
發表於 2013-3-26 14:21 | 只看該作者
回復 12# GBKEE


    想請問一下大大
    程式中當我點選日期的時候
    會跳出警告視窗
    告知你點選的是年月日

    那如果是要點選日期後就動作
    直接寫入指定欄位是要在哪裡撰寫呢？(例如：Sheet1.Range("A1"))
　由於表單頁面上的OptionButton都是隱藏的
    因此我添加程式不曉得寫哪裡
   
    希望大大解除我的疑惑
    感激不盡！><
Jared

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
15#
發表於 2013-3-26 14:52 | 只看該作者
回復 14# Jared
物件類別模組 Class1
  1. Option Explicit
  2. Public WithEvents OB As MSForms.OptionButton
  3. Private Sub OB_Click()
  4.     'MsgBox OB.Caption
  5.     '年月日
  6.     Sheet1.[a1] = OB.ControlTipText
  7.     '日期
  8.     'Sheet1.[a1] = OB.Caption
  9. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

Jared

帖子
103 
主題
30 
精華
0 
積分
139 
點名
0  
作業系統
wondows XP 
軟體版本
office 2007 
閱讀權限
20 
性別
男 
來自
彰化 
註冊時間
2013-2-21 
最後登錄
2015-6-26 
16#
發表於 2013-3-26 15:14 | 只看該作者
回復 15# GBKEE


    感謝大大解開我的疑惑
    原來我弄錯地方了
    沒注意到Class 物件類別模組裡面的程式碼
    搞不懂 OB是什麼意思

    剛剛是想在
    With Controls.Add("Forms.OptionButton.1", I) 裡面加入
    If .Visible = True Then
    Sheet1.Range("A1") = DateSerial(ComboBox1, ComboBox2, Day(I))
    End If
   
    但原本表單上面就沒有出現OptionButton
    所以天數那裡也不曉得怎麼用
    現在我知道了

    不過看來我還要繼續加油了...><
Jared

TOP

mark15jill
　暱稱: 隨風飄蕩的羽毛
　頭銜: [御用]潛水艇

高中生Rank: 3Rank: 3

帖子
852 
主題
79 
精華
0 
積分
918 
點名
0  
作業系統
Windows 7 , XP 
軟體版本
Office 2007, Office 2003,Office 2010,YoZo Office 
閱讀權限
50 
性別
男 
來自
宇宙 
註冊時間
2011-4-8 
最後登錄
2024-2-21 
17#
發表於 2013-3-26 16:34 | 只看該作者
回復  mark15jill


大大
後來發現運算式都錯了
計算出來的天數都不對....>
Jared 發表於 2013-3-26 14:09



關於天數
這個我後來有發現
而且神奇的是....

我用VB.NET 和VBA  用同 計算式去跑..
結果VB.NET 完全正確..
VBA會莫名其妙錯亂..<天數對  星期錯亂>

  多做多想多學習，少看少錯少迷途

  多做=多多練習，多多編寫。
  多想=想想為什麼人家程式要那樣寫，如果換成自己，又會怎寫。
  多學習=學習人家的發問並解答，學習人家的寫法

  少看=只看不做也枉然

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
18#
發表於 2013-3-26 17:02 | 只看該作者
回復 17# mark15jill
   
<天數對  星期錯亂>
星期錯亂: 你是用何函數
傳上程式碼看看
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

mark15jill
　暱稱: 隨風飄蕩的羽毛
　頭銜: [御用]潛水艇

高中生Rank: 3Rank: 3

帖子
852 
主題
79 
精華
0 
積分
918 
點名
0  
作業系統
Windows 7 , XP 
軟體版本
Office 2007, Office 2003,Office 2010,YoZo Office 
閱讀權限
50 
性別
男 
來自
宇宙 
註冊時間
2011-4-8 
最後登錄
2024-2-21 
19#
發表於 2013-3-27 08:10 | 只看該作者
回復  mark15jill
     星期錯亂: 你是用何函數
傳上程式碼看看
GBKEE 發表於 2013-3-26 17:02





    任何高深函數都沒用到... XDD

            Dim K1, K2, K3 As Integer
            Dim yy, dd, mm, wek, dss, dds31, dds30, dds2, dds28, dds29 As Integer
            Dim uny, unm, und, unym, unmd As String
            Dim weeks(6) As String

            DTP1 = DaTiPi.Text
            uny = InStr(DTP1, "年") - 1 : unm = InStr(1, DTP1, "月") : und = InStr(DTP1, "日") - 1
            unym = Mid(DTP1, uny + 1, unm - 5) : unmd = Mid(DTP1, unm + 1, und - 1)

            K1 = InStr(1, DTP1, "年") : K2 = InStr(1, DTP1, "月") : K3 = InStr(1, DTP1, "日")

            yy = Mid(DTP1, 1, K1 - 1) '年
            mm = Mid(DTP1, K1 + 1, (K2 - K1) - 1) '月
            dd = Mid(DTP1, K2 + 1, (K3 - K2) - 1) '日
            dss = 30 + ((mm + (mm > 7)) Mod 2) + (2 + (yy Mod 4 = 0) + (yy Mod 100 = 0) * (yy Mod 400 <> 0)) * (mm = 2) '日 二月專用
            dds31 = 31 : dds30 = 30  'dds 為  31日 和 30日
            dds2 = dss '日 二月專用

  多做多想多學習，少看少錯少迷途

  多做=多多練習，多多編寫。
  多想=想想為什麼人家程式要那樣寫，如果換成自己，又會怎寫。
  多學習=學習人家的發問並解答，學習人家的寫法

  少看=只看不做也枉然

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
255  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-11-25 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
20#
發表於 2013-3-27 09:37 | 只看該作者
本帖最後由 Hsieh 於 2013-3-27 09:46 編輯

回復 19# mark15jill

萬年曆在現在的系統內已經是內建了
不用VBA日期函數計算星期幾，直接用基準日期間距來算就對了
系統支援最小日期1900/1/1是星期日其日期序列號為1
  1. d = CDate(InputBox("輸入完整西元日期字串", , Date))
  2. MsgBox IIf((d - 1) Mod 7, (d - 1) Mod 7, 7)
複製代碼
學海無涯_不恥下問

TOP

        靜思自在 : 能付出愛心就是福，能消除煩惱就是慧。
123
返回列表 上一主題