macros为Excel文档中的每一行创build单独的单词页面

目标:为我的Excel文档中的每一行创build一个单独的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. 我希望代码是dynamic的,然后循环遍历所有列,而不必定义每一列。
  3. 我希望每个回复都在Word文档的单独页面上。

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

 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