在Excel中为每行创建单独的单词页面文档

Question

目标：为我的Excel文档中的每一行创建一个单独的Word页面（全部可以在同一个Word文档中）。

第1行包含问题，第2-n行包含人们的回答。以下是我想要的输出：

Page 1 of Word Doc: 

A1 Question 

A2 Answer 

B1 Question 

B2 Answer 

etc. 

Page 2 of Word Doc: 


A1 Question 


A3 Answer 


B1 Question 


B3 Answer 

etc. 

如果在Word输出中可能有问题（所有行1）加粗，那太棒了！

这是我现在正在使用的代码。

Sub WordDoc() 
Dim TextEnter As String 
Dim RowNum As Integer 
Dim wordApp As Object 
Set wordApp = CreateObject("word.application") 'Takes the object wordApp and assigns it as a Microsoft Word application 
wordApp.Visible = True 'Word application is visible 

'Adds a new document to the application 
wordApp.Documents.Add _ 
Template:="", _ 
NewTemplate:=False 

RowNum = 1 

'Loop continues until a blank line is read; can be edited as necessary 
Do While Range("A" & RowNum).Text <> "" 
    TextEnter = Range("A" & RowNum).Text & " " & Range("B" & RowNum).Text & " " & Range("C" & RowNum).Text & " " & Range("D" & RowNum).Text & " " & Range("E" & RowNum).Text & " " & Range("F" & RowNum).Text & " " & Range("G" & RowNum).Text & " " & Range("H" & RowNum).Text 
    'Puts text of row into a string adjust to the number of columns by adding more range 
    wordApp.Selection.TypeParagraph 'Moves to the next line in word doc 
    wordApp.Selection.TypeText Text:=TextEnter 'Enters Text to document 
    RowNum = RowNum + 1 'Increments to the next row 
Loop 
End Sub 

问题与当前代码：

1. 我需要行1被重复用于每个响应。现在，代码只是将行的信息捆绑到一个段落中。
2. 我希望代码是动态的，然后循环遍历所有列，而不必定义每一列。
3. 我希望每个回复都在Word文档的单独页面上。

Answer 1

注意到我的代码是内嵌的。

Sub WordDoc() 
    Dim TextEnter As String 
    Dim RowNum As Integer 
    Dim wordApp As Object 
    Dim LastRow, LastCol, CurRow, CurCol As Long 

    Set wordApp = CreateObject("word.application") 'Takes the object wordApp and assigns it as a Microsoft Word application 
    wordApp.Visible = True 'Word application is visible 

    'Adds a new document to the application 
    wordApp.Documents.Add _ 
    Template:="", _ 
    NewTemplate:=False 

    LastRow = Range("A" & Rows.Count).End(xlUp).Row 
    LastCol = Cells(1, Columns.Count).End(xlToLeft).Column 

    'For... Next Loop through all rows 
    For CurRow = 2 To LastRow 
     TextEnter = "" 
     'For... Next Loop to combine all columns (header and answer) for given row into string 
     For CurCol = 1 To LastCol 
      TextEnter = TextEnter & Cells(1, CurCol).Value & vbCrLf & Cells(CurRow, CurCol).Value & vbCrLf 
     Next CurCol 
     wordApp.Selection.TypeParagraph 'Moves to the next line in word doc 
     wordApp.Selection.TypeText Text:=TextEnter 'Enters Text to document 
     wordApp.Selection.InsertBreak Type:=7 ' wdPageBreak 
    Next CurRow 

End Sub