Question

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

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

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行。现在，代码只是将行的信息捆绑在一个段落中。
我希望代码是动态的，然后遍历很多列，而不必定义每一列。
我希望每个回复都在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

宏为Excel文档中的每一行创建单独的Word页面

1 个答案: