Board logo

標題: 利用VBA 表單製作萬年曆? [打印本頁]
作者: Jared    時間: 2013-3-25 15:33     標題: 利用VBA 表單製作萬年曆?

想請問各位大大
如果我想利用VBA表單功能來製作萬年曆
但就是不知道如何著手

網路上能搜尋到的資源
都是利用函數在Sheet 上面運算
有試過轉移到表單上面去執行
[attach]14442[/attach]
卻不知道少了什麼
表單的配置如下
[attach]14441[/attach]

希望有高人指點迷津，感激不盡>"<
作者: mark15jill    時間: 2013-3-25 15:50

回復 1# Jared


    1.印象中，論壇有 office專用月曆附件... 可以找看看。
    2.是否有考慮 潤年的潤二月？(28 29)
    3.呈現方式為?? 處發方式？
作者: Jared    時間: 2013-3-25 15:58

本帖最後由 Jared 於 2013-3-25 15:59 編輯

回復 2# mark15jill

感謝大大回覆:)
如果是要利用表單自行寫程式
這樣可行嗎?
因為我在念書時老師有教過利用VB 來寫過
但已經距離我很久了...

觸發方式
當我選擇年(A)、月(B)後
底下的點選數字會浮現出來
小於1 & 大於31會隱藏起來
當然還有月份沒31號的也隱藏

至於潤二月(@@)..好像要套公式進去
這樣可行嗎??
作者: mark15jill    時間: 2013-3-25 16:49

回復 3# Jared


[attach]14446[/attach]



簡易版萬年曆
但會有  
1.   30 31 的判斷問題
2.   潤2月問題...
3.  物件隱藏問題
但以上問題相信依照您的能力可自己去添加

執行畫面
[attach]14447[/attach]
[attach]14448[/attach]
作者: GBKEE    時間: 2013-3-25 17:41

本帖最後由 GBKEE 於 2013-3-25 20:34 編輯

回復 4# mark15jill
試試看

[attach]14451[/attach]
作者: Jared    時間: 2013-3-26 09:22

回復 4# mark15jill


    感謝大大大力協助
   畫面上呈現的跟我預想的一樣(0口0)"
  看來我真的修行不夠><
  原本我程式是寫這樣
   但程式就判斷找不到DAY_i.Caption 這個成員....
    繼續努力中...
Private Sub ComboBox2_Change()
If ComboBox1.ListIndex > -1 Then
    chang_day
    a = DateSerial(ComboBox1.Value, ComboBox2.Value, 1)         '本月起始日
    b = DateSerial(ComboBox1.Value, ComboBox2.Value + 1, 1)     '下月起始日
    c = DateSerial(ComboBox1.Value, ComboBox2.Value + 1, 1) - 1 '本月結束日
    d = Weekday(TextBox1)                                       '第一天位置
Else
   ComboBox2 = ""
End If
End Sub

Sub chang_day()
Dim i, j, x, y

y = DateSerial(ComboBox1.Value, ComboBox2.Value + 1, 1) - 1
For i = 1 To 42
x = DAY_i - Weekday(DateSerial(ComboBox1.Value, ComboBox2.Value, 1)) + (DAY_i - 3) * 7
DAY_i.Caption = x
Next
End Sub
作者: GBKEE    時間: 2013-3-26 10:02

回復 6# Jared
但程式就判斷找不到DAY_i.Caption 這個成員....
沒有檔案看不到 DAY_i 是如何設定的,是這樣嗎?
  1. Controls("DAY_" & I).Caption
複製代碼
回復 4# mark15jill

圖片上的程式碼,需要有好眼力才看的到,何不代碼貼上來
作者: Jared    時間: 2013-3-26 10:04

回復 5# GBKEE


    (0口0)...想請問大大
    為什麼畫面一開始都沒東西?
    是在哪一行程式宣告隱藏呢?
    程式中 宣告 好多沒見過的語法(@@)...
作者: Jared    時間: 2013-3-26 10:11

回復 7# GBKEE


    回覆大大
    DAY_i 是如何設定的?
    DAY_i 就是OptionButton1 屬性NAME 改成DAY_1 ~42
    [attach]14455[/attach]   
是想利用For 迴圈去計算
最後在加上判斷式
計算出來的數字小於1或大於31就隱藏起來
但就是跑不過卡在這裡

    剛剛利用大大的回覆程式碼成功了(^口^)
     不過卻變成同一種數字....(u_u)
      [attach]14456[/attach]
作者: mark15jill    時間: 2013-3-26 12:00

回復 7# GBKEE


    拍謝..  因為想說拍成一張 比較省空間...
下次會改建...
作者: mark15jill    時間: 2013-3-26 12:02

回復 9# Jared

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

例如
k=1
for hwe = 1 to 31

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

next
作者: GBKEE    時間: 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
複製代碼
作者: Jared    時間: 2013-3-26 14:09

回復 11# mark15jill


大大
後來發現運算式都錯了
計算出來的天數都不對....><
作者: Jared    時間: 2013-3-26 14:21

回復 12# GBKEE


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

    那如果是要點選日期後就動作
    直接寫入指定欄位是要在哪裡撰寫呢？(例如：Sheet1.Range("A1"))
　由於表單頁面上的OptionButton都是隱藏的
    因此我添加程式不曉得寫哪裡
   
    希望大大解除我的疑惑
    感激不盡！><
作者: GBKEE    時間: 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
複製代碼
[attach]14458[/attach]
作者: Jared    時間: 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
    所以天數那裡也不曉得怎麼用
    現在我知道了

    不過看來我還要繼續加油了...><
作者: mark15jill    時間: 2013-3-26 16:34

回復  mark15jill


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



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

我用VB.NET 和VBA  用同 計算式去跑..
結果VB.NET 完全正確..
VBA會莫名其妙錯亂..<天數對  星期錯亂>
作者: GBKEE    時間: 2013-3-26 17:02

回復 17# mark15jill
   
<天數對  星期錯亂>
星期錯亂: 你是用何函數
傳上程式碼看看
作者: mark15jill    時間: 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 '日 二月專用
作者: Hsieh    時間: 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)
複製代碼
作者: mark15jill    時間: 2013-3-27 10:39

回復  mark15jill

萬年曆在現在的系統內已經是內建了
不用VBA日期函數計算星期幾，直接用基準日期間距 ...
Hsieh 發表於 2013-3-27 09:37



    Heish大大 ，印象中，好像2003 還是2007 還是2010 沒有所謂的 日曆  這元件..
    另外，若用 不用VBA日期函數計算星期幾，直接用基準日期間距 ...  
     很容易產生，潤2月的情形。
     而且 若是又牽扯到 需要製作農曆萬年曆，那會有 潤農曆月的問題
      呵呵

        抱歉，小弟無知，多言了。
作者: Hsieh    時間: 2013-3-27 11:03

回復 21# mark15jill
OFFICE 2010以後已經取消了日曆控制項元件
計算星期幾?與閏年無關，因為Windows是以序列號計算日期，而星期就是以7天為一循環
至於農曆閏年，規則太過複雜，必須配合節氣計算，個人才疏學淺無法提出具體做法
作者: GBKEE    時間: 2013-3-27 13:17

本帖最後由 GBKEE 於 2013-3-27 13:33 編輯

回復 19# mark15jill
你好像繞了一圈.
回復 21# mark15jill
製作陽曆萬年曆與潤2月是沒有關係的
  1. Sub Ex()
  2.     Dim D As String
  3.     D = "2013/2/21"
  4.     MsgBox D & " 後一天 " & DateSerial(Year(D), Month(D) + 1, 0)
  5.     '每月的後一天
  6.     MsgBox Format(D, "aaa")
  7. End Sub
複製代碼
作者: mark15jill    時間: 2013-3-27 15:32

回復  mark15jill
你好像繞了一圈.
回復  mark15jill
製作陽曆萬年曆與潤2月是沒有關係的
GBKEE 發表於 2013-3-27 13:17



    感謝 兩位大大的教導，小弟受教了。
作者: Jared    時間: 2013-3-28 14:22

回復 19# mark15jill


    (@@)...好多Dim
    看得眼花撩亂...
    建議可以用簡單的A、B、C、D來命名(u_u)



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)