EXCEL VBA 輸出陣列到 WORD TABLE(月曆) 摘要

'*******************************************************************
'
' 變數資料處理完成，傳送資料到WORD應用程式。
'
'*******************************************************************
Dim Myword As New Word.Application
Dim Newdoc As Word.Document
Dim tbl As Word.Table


'Set Myword = CreateObject("Word.Application")
Myword.Caption = ""

'Myword.ActiveDocument.Path
'Myword.Visible = True

Set Newdoc = Myword.Documents.Open(ThisWorkbook.Path & "\Month.doc", , True) '設定成「唯讀」以免資料被寫入。

Newdoc.FormFields("MonthV").Range.Text = SelMonth & "月份一覽表"

'NewDoc.FormFields("pName").Range.Text = Range("E2")

'*************************************************************8
'增加表格

SelDate = DateSerial(Year(Date), SelMonth, 1)
SelDate2 = DateAdd("m", 1, SelDate)
TotalDays = DateDiff("d", SelDate, SelDate2)
' Debug.Print SelDate & " " & SelDate2
' Debug.Print TotalDays & " " & Selw

'Exit Sub

Set tbl = Newdoc.Tables(1)

Dim Rows As Integer
Rows = 2
'依照(陣列)資料輸出到表格
For i = 1 To TotalDays
SelDate2 = DateAdd("d", i - 1, SelDate)
Selw = Weekday(SelDate2, vbSunday)

tbl.Cell(Rows - 1, Selw).Range.Text = SelMonth & "/" & Day(SelDate2) & "(" & TransWeekName(Selw) & ")"
tbl.Cell(Rows, Selw).Range.Text = DayArray(i)

Debug.Print " (" & (Rows - 1) & "," & Selw & ") " & SelMonth & "/" & Day(SelDate2) & "(" & TransWeekName(Selw) & ")"
Debug.Print " (" & (Rows) & "," & Selw & ") " & SelMonth & "/" & Day(SelDate2) & "(" & TransWeekName(Selw) & ")"

If Selw = 7 Then '7星期六 1 星期日
Rows = Rows + 2
End If
Next

If Rows <= 10 Then
tbl.Rows.Last.Delete
tbl.Rows.Last.Delete
End If


'修改滑鼠游標
'Me.MousePointer = vbNormal
Dim Fn As String
Fn = Year(Date) - 1911 & "-" & Month(Date) & "-" & Day(Date) & " [ " & SelMonth & " ]月份差假表" & ".doc"

Newdoc.SaveAs ThisWorkbook.Path & "\" & Fn

'清除與WORD物件的連結。
Newdoc.Close
Myword.Quit

Set Newdoc = Nothing
Set Myword = Nothing

MsgBox "請在程式所在目錄之下尋找剛才所建立的WORD檔案！" & vbCrLf & "檔名：" & Fn