返回列表 上一主題 發帖

[發問] 請求指導簡易月曆行事曆製作

回復 1# reangame

請附上行程輸入表單的檔案,才知道你的表單結構
學海無涯_不恥下問

TOP

本帖最後由 Hsieh 於 2014-5-28 13:45 編輯

回復 3# reangame
行事曆的製作,應該要有選擇年月的機制
設置2個下拉選單如動畫
月曆完成後,行事表單你似乎已經知道寫成資料庫
再將要寫入行事月曆的欄位抓出來即可
play.gif
月曆.zip (47.18 KB)
工作表模組程式碼
  1. Private Sub ComboBox1_Change()
  2. If ComboBox1 <> "" And ComboBox2 <> "" Then 行事曆製作
  3. End Sub

  4. Private Sub ComboBox2_Change()
  5. If ComboBox1 <> "" And ComboBox2 <> "" Then 行事曆製作
  6. End Sub

  7. Sub 行事曆製作()
  8. Dim Ob As Shape, A As Range
  9. For Each Ob In Me.Shapes
  10. If Not Ob.Name Like "ComboBox*" Then Ob.Delete
  11. Next
  12. [B3:H8].Clear
  13. day1 = DateSerial(Val(ComboBox1), Val(ComboBox2), 1)
  14. day2 = DateSerial(Val(ComboBox1), Val(ComboBox2) + 1, 0)
  15. w = Weekday(day1, vbMonday)
  16. For i = day1 To day2
  17. k = Int((Day(i) + w - 2) / 7)
  18. s = Weekday(i, 2)
  19. Set A = [A3].Offset(k, s)
  20. If s >= 6 Then A.Interior.ColorIndex = 36
  21. With Me.Shapes.AddLabel(msoTextOrientationHorizontal, A.Left, A.Top, 10, 72)
  22. .TextFrame.AutoSize = True
  23.   .TextFrame.Characters.Caption = Day(i)
  24. End With
  25. Next

  26. With Range([B3], Cells(A.Row, 8))
  27. For j = 1 To 4
  28.   With .Borders(j)
  29.    .LineStyle = 1
  30.    .Weight = 2
  31.    .ColorIndex = xlColorIndexAutomatic
  32.   End With
  33. Next
  34. End With
  35. End Sub

  36. Private Sub Worksheet_Activate()
  37. With ComboBox1
  38. For i = .ListCount - 1 To 0 Step -1
  39. .RemoveItem i
  40. Next
  41. For Y = 1999 To 2100
  42.   .AddItem Y
  43. Next
  44. .Text = Year(Date)
  45. End With

  46. With ComboBox2
  47. For i = .ListCount - 1 To 0 Step -1
  48. .RemoveItem i
  49. Next
  50. For Y = 1 To 12
  51.   .AddItem Y
  52. Next
  53. .Text = Month(Date)
  54. End With
  55. End Sub
複製代碼
學海無涯_不恥下問

TOP

        靜思自在 : 屋寬不如心寬。
返回列表 上一主題