|
とりあえず順番に転記するだけなら。
Sub test()
Dim wd As Object
Dim doc As Object
Dim c As Range
Const wdHeaderFooterPrimary = 1
On Error Resume Next
Set wd = GetObject(, "Word.Application")
If wd Is Nothing Then
Set wd = CreateObject("Word.Application")
End If
On Error GoTo 0
wd.Visible = True
Set doc = wd.Documents.Open(ThisWorkbook.Path & "\test.docx")
For Each c In Range("A1", Cells(Rows.Count, 1).End(xlUp))
doc.Sections(1).Headers(wdHeaderFooterPrimary).Range.Text = c.Value
doc.PrintOut
Next
doc.Close False
wd.Quit
Set doc = Nothing
Set wd = Nothing
End Sub
|
|