Board logo

標題: [發問] 請求指導簡易月曆行事曆製作 [打印本頁]
作者: reangame    時間: 2014-5-25 18:50     標題: 請求指導簡易月曆行事曆製作

本帖最後由 reangame 於 2014-5-25 18:53 編輯

各位大大您好：
最近想以VBA製作一個簡易月曆行事曆，
可是爬了好多文章，就是找不到簡易月曆行事曆的範例，
我的行程輸入表單已經製作好了，是以一列為一個行程紀錄(欄位包括年、月、日、行程名稱、參加人員等)，
現在想要把資料輸出為月曆行事曆，可是想破頭都還想不出該如何下手，
想要製作的月曆行事曆格式如附檔[attach]18363[/attach]，
主要問題出在不知道如何把多筆行程資料依日期輸出到該日期的儲存格，
請問該如何以VBA自動抓取行程記錄後輸出到月曆行事曆，拜託各位大大指點給個方向，感激不盡！
作者: Hsieh    時間: 2014-5-26 15:59

回復 1# reangame

請附上行程輸入表單的檔案，才知道你的表單結構
作者: reangame    時間: 2014-5-27 21:45

回復 2# Hsieh

Hsieh大大，您好：
不好意思，昨天出差沒辦法上網來回覆您，表單如下：
[attach]18387[/attach]
先跟您報告，主要是想以VBA自動化把一整個月的資料輸出成月曆行事曆，
自動化出現某一個月的月曆，行程資料依日期填入該日期的儲存格，如果同一天有多場行程，儲存格內以一行一筆行程(換行)顯示，
請指導一下，
第一：如何自動化抓取某一個月份讓資料顯示像1樓的月曆格式，
第二：如何將資料依日期填入該日期儲存格，(可能會有日期沒行程，且月曆的日期不為固定位置)

以上，主要還是以第一個問題為主，因不知道如何自動化顯示月曆格式的程式碼寫法，所以，第二問題連測試都沒辦法，請大大協助或者給個方向，感激不盡！
作者: Hsieh    時間: 2014-5-28 11:16

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

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

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

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

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

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

  51. With ComboBox2
  52. For i = .ListCount - 1 To 0 Step -1
  53. .RemoveItem i
  54. Next
  55. For Y = 1 To 12
  56.   .AddItem Y
  57. Next
  58. .Text = Month(Date)
  59. End With
  60. End Sub
複製代碼
作者: reangame    時間: 2014-5-28 17:03

回復 4# Hsieh

Hsieh大大，您好：
今天休假，下午起來看到您的回覆，真是太驚奇了，
已經測試過確實可以執行，其中感到最特別的程式碼：
  1.     For Each Ob In Me.Shapes
  2.         If Not Ob.Name Like "ComboBox*" Then Ob.Delete
  3.     Next
複製代碼
我查了一下，Like的定義：用來比較兩個字串，
測試Ob.Name得到ComboBox1.ComboBox2.TextBox........
所以，意思是除了ComboBox外的物件都刪除；
  1. k = Int((Day(i) + w - 2) / 7)
複製代碼
這句也是研究半天，後來才搞懂，
因表格第一個欄位是星期一(vbMonday，也就是2)，
Int：傳回數值的整數部份，
藉以計算該日期的儲存格位置是否該往下移動一列，
  1.         With Me.Shapes.AddLabel(msoTextOrientationHorizontal, A.Left, A.Top, 10, 72)
  2.             .TextFrame.AutoSize = True
  3.             .TextFrame.Characters.Caption = Day(i)
  4.         End With
複製代碼
以前從沒看過的程式碼，這就是自動加入文字物件的方法。

只能說您實在是太厲害了！小弟實在太敬佩了！
希望以後還請您多多指教！
作者: reangame    時間: 2014-5-28 17:08

回復 4# Hsieh

Hsieh大大：
另外請教您一下，您的動畫是如何製作的?
用這個方法來製作教學檔，好像也蠻不錯的。
作者: yen956    時間: 2014-5-30 08:13

回復 4# Hsieh
Hsieh版大，您好：
超級簡明又實用, 收下, 謝謝!!
作者: phoebegin    時間: 2017-3-16 09:40

這地方高手雲集~想要學什麼可以~

最近我也為了月曆的事情大傷腦筋~想不到一回來這~就迎刃而解

真是太棒了
作者: hcm19522    時間: 2017-3-17 09:29

http://blog.xuite.net/hcm19522/twblog/403105361
作者: jeffrey628litw    時間: 2017-3-19 18:47

小弟不才，本來試4樓超級版主的檔案試不出來。後來發現原來
'Private Sub Worksheet_Activate()    後來發現原來Worksheet要加1
變成Private Sub Worksheet1_Activate() 這樣才跑得動


Private Sub Worksheet1_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
作者: jsc0518    時間: 2017-3-19 19:08

回復 4# Hsieh


這Excel日曆很實用，超感謝您的!



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