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

reangame

各位大大您好：
最近想以VBA製作一個簡易月曆行事曆，
可是爬了好多文章，就是找不到簡易月曆行事曆的範例，
我的行程輸入表單已經製作好了，是以一列為一個行程紀錄(欄位包括年、月、日、行程名稱、參加人員等)，
現在想要把資料輸出為月曆行事曆，可是想破頭都還想不出該如何下手，
想要製作的月曆行事曆格式如附檔 月曆.rar (4.97 KB)

下載次數: 13

2014-5-25 18:40

，
主要問題出在不知道如何把多筆行程資料依日期輸出到該日期的儲存格，
請問該如何以VBA自動抓取行程記錄後輸出到月曆行事曆，拜託各位大大指點給個方向，感激不盡！

Hsieh

回復 1# reangame

請附上行程輸入表單的檔案，才知道你的表單結構

reangame

回復 2# Hsieh

Hsieh大大，您好：
不好意思，昨天出差沒辦法上網來回覆您，表單如下：
行程表單.rar (47.69 KB)

下載次數: 25

2014-5-27 21:26

先跟您報告，主要是想以VBA自動化把一整個月的資料輸出成月曆行事曆，
自動化出現某一個月的月曆，行程資料依日期填入該日期的儲存格，如果同一天有多場行程，儲存格內以一行一筆行程(換行)顯示，
請指導一下，
第一：如何自動化抓取某一個月份讓資料顯示像1樓的月曆格式，
第二：如何將資料依日期填入該日期儲存格，(可能會有日期沒行程，且月曆的日期不為固定位置)

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

Hsieh

回復 3# reangame
行事曆的製作，應該要有選擇年月的機制
設置2個下拉選單如動畫
月曆完成後，行事表單你似乎已經知道寫成資料庫
再將要寫入行事月曆的欄位抓出來即可

下載 (153.8 KB)

2014-5-28 11:15

月曆.zip (47.18 KB)

下載次數: 41

2014-5-28 11:16

工作表模組程式碼

1. Private Sub ComboBox1_Change()
   
2. If ComboBox1 <> "" And ComboBox2 <> "" Then 行事曆製作
   
3. End Sub
   
4. 
   
5. Private Sub ComboBox2_Change()
   
6. If ComboBox1 <> "" And ComboBox2 <> "" Then 行事曆製作
   
7. End Sub
   
8. 
   
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
    
28. 
    
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
    
39. 
    
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
    
50. 
    
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

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

回復 4# Hsieh

Hsieh大大：
另外請教您一下，您的動畫是如何製作的?
用這個方法來製作教學檔，好像也蠻不錯的。

yen956

回復 4# Hsieh
Hsieh版大，您好：
超級簡明又實用, 收下, 謝謝!!

phoebegin

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

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

真是太棒了

hcm19522

http://blog.xuite.net/hcm19522/twblog/403105361

jeffrey628litw

小弟不才，本來試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