mark15jill

回復 9# Jared

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

例如
k=1
for hwe = 1 to 31

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

next

GBKEE

回復 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

回復 11# mark15jill


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

Jared

回復 12# GBKEE


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

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

GBKEE

回復 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

複製代碼

下載 (52.75 KB)

2013-3-26 14:52

Jared

回復 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

回復  mark15jill


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

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

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

GBKEE

回復 17# mark15jill
   

<天數對  星期錯亂>

星期錯亂: 你是用何函數
傳上程式碼看看

mark15jill

回復  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

回復 19# mark15jill

萬年曆在現在的系統內已經是內建了
不用VBA日期函數計算星期幾，直接用基準日期間距來算就對了
系統支援最小日期1900/1/1是星期日其日期序列號為1

1. d = CDate(InputBox("輸入完整西元日期字串", , Date))
   
2. MsgBox IIf((d - 1) Mod 7, (d - 1) Mod 7, 7)

複製代碼