- 帖子
- 4901
- 主題
- 44
- 精華
- 24
- 積分
- 4916
- 點名
- 257
- 作業系統
- Windows 7
- 軟體版本
- Office 20xx
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台北
- 註冊時間
- 2010-4-30
- 最後登錄
- 2024-11-27
              
|
4#
發表於 2014-5-28 11:16
| 只看該作者
本帖最後由 Hsieh 於 2014-5-28 13:45 編輯
回復 3# reangame
行事曆的製作，應該要有選擇年月的機制
設置2個下拉選單如動畫
月曆完成後，行事表單你似乎已經知道寫成資料庫
再將要寫入行事月曆的欄位抓出來即可
 月曆.zip (47.18 KB)
工作表模組程式碼- Private Sub ComboBox1_Change()
- If ComboBox1 <> "" And ComboBox2 <> "" Then 行事曆製作
- End Sub
- Private Sub ComboBox2_Change()
- If ComboBox1 <> "" And ComboBox2 <> "" Then 行事曆製作
- End Sub
- Sub 行事曆製作()
- Dim Ob As Shape, A As Range
- For Each Ob In Me.Shapes
- If Not Ob.Name Like "ComboBox*" Then Ob.Delete
- Next
- [B3:H8].Clear
- day1 = DateSerial(Val(ComboBox1), Val(ComboBox2), 1)
- day2 = DateSerial(Val(ComboBox1), Val(ComboBox2) + 1, 0)
- w = Weekday(day1, vbMonday)
- For i = day1 To day2
- k = Int((Day(i) + w - 2) / 7)
- s = Weekday(i, 2)
- Set A = [A3].Offset(k, s)
- If s >= 6 Then A.Interior.ColorIndex = 36
- With Me.Shapes.AddLabel(msoTextOrientationHorizontal, A.Left, A.Top, 10, 72)
- .TextFrame.AutoSize = True
- .TextFrame.Characters.Caption = Day(i)
- End With
- Next
- With Range([B3], Cells(A.Row, 8))
- For j = 1 To 4
- With .Borders(j)
- .LineStyle = 1
- .Weight = 2
- .ColorIndex = xlColorIndexAutomatic
- End With
- Next
- End With
- End Sub
- Private Sub Worksheet_Activate()
- With ComboBox1
- For i = .ListCount - 1 To 0 Step -1
- .RemoveItem i
- Next
- For Y = 1999 To 2100
- .AddItem Y
- Next
- .Text = Year(Date)
- End With
- With ComboBox2
- For i = .ListCount - 1 To 0 Step -1
- .RemoveItem i
- Next
- For Y = 1 To 12
- .AddItem Y
- Next
- .Text = Month(Date)
- End With
- End Sub
|
|
發表於 2014-5-25 18:50
| 
