将多个表格从Excel导出到Word时表格被覆盖

Question

我正在尝试使用VBA创建一个Word文档，该文档具有多个表，每个表都在一个新页面上（使用循环），并使用来自Excel的单元格信息进行编译。

到目前为止，除插入第一个表后，第二个表将其替换为第二个表，然后将第三个表替换为第二个表，以此类推。 我剩下的只是最后创建的表。

我不确定如何导致创建新表而不是替换先前创建的表。

Excel表的屏幕截图

Sub Export_to_Word()

    '(1) Word objects.
    Dim wdApp As Word.Application
    Dim wdDoc As Word.Document
    Dim wdCell As Word.Cell
    Dim wdTabl As Word.Table
    Dim wdRange As Word.Range


    '(2) Excel objects
    Dim wbBook As Workbook
    Dim wsSheet As Worksheet
    Dim strValue As String
    Dim i As Integer
    Dim x As Integer

        'For assiging integer value to calculate number of table rows
        Dim ARows As Integer
        Dim BRows As Integer
        Dim CRows As Integer
        Dim DRows As Integer

        'For copying question part as a value in the excel sheet
        Dim QueNum As Variant
        Dim PartA As Variant
        Dim PartB As Variant
        Dim PartC As Variant
        Dim PartD As Variant

        'For copying the question in the excel sheet
        Dim QueA As Variant
        Dim QueB As Variant
        Dim QueC As Variant
        Dim QueD As Variant

        'For copying question part as a value in the excel sheet
        Dim MarkA As Variant
        Dim MarkB As Variant
        Dim MarkC As Variant
        Dim MarkD As Variant

        'For copying the answers in the excel sheet
        Dim AnsA As Variant
        Dim AnsB As Variant
        Dim AnsC As Variant
        Dim AnsD As Variant

        'For copying the header values in the excel sheet
        Dim CandCode As Variant
        Dim AnPath As Variant
        Dim Logo As Variant
        Dim EngNam As Variant
        Dim EngTex As Variant
        Dim FreNam As Variant
        Dim FreTex As Variant


    '(4) Initialize the Excel objects
    Set wbBook = ThisWorkbook
    Set wsSheet = wbBook.Worksheets("Sheet1")


    '(5)Create table in excel before copying to word
    'Create Word file.
    Set wdApp = New Word.Application
            wdApp.Visible = True
    Set wdDoc = wdApp.Documents.Add


    '(5a)Enter excel values into header
    With wdDoc.Sections(1)
        .Headers(wdHeaderFooterPrimary).Range.Text = CandCode & vbCr & vbCr & AnPath
        .Headers(wdHeaderFooterPrimary).Range.Font.Name = "Arial"
        .Headers(wdHeaderFooterPrimary).Range.Font.Size = 7
        .Headers(wdHeaderFooterPrimary).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
    End With

    '(5b)Start of new cycle for loop
    For i = 4 To 6

    '(5c) Equate cell values to the the variables defined under Excel objects (Part 2). N.B in equation "Cells(3,i) 3= row number and i=column number
        ARows = wsSheet.Cells(3, i).Value
        BRows = wsSheet.Cells(7, i).Value
        CRows = wsSheet.Cells(11, i).Value
        DRows = wsSheet.Cells(15, i).Value

        QueNum = wsSheet.Cells(1, i).Value
        PartA = wsSheet.Range("A2").Value
        PartB = wsSheet.Range("A6").Value
        PartC = wsSheet.Range("A10").Value
        PartD = wsSheet.Range("A14").Value

        QueA = wsSheet.Cells(2, i).Value
        QueB = wsSheet.Cells(6, i).Value
        QueC = wsSheet.Cells(10, i).Value
        QueD = wsSheet.Cells(14, i).Value

        MarkA = wsSheet.Cells(4, i).Value
        MarkB = wsSheet.Cells(8, i).Value
        MarkC = wsSheet.Cells(12, i).Value
        MarkD = wsSheet.Cells(16, i).Value

        AnsA = wsSheet.Cells(5, i).Value
        AnsB = wsSheet.Cells(9, i).Value
        AnsC = wsSheet.Cells(13, i).Value
        AnsD = wsSheet.Cells(17, i).Value

        CandCode = wsSheet.Range("V24").Value
        AnPath = wsSheet.Range("V25").Value
        Logo = wsSheet.Range("V26").Value
        EngNam = wsSheet.Range("V27").Value
        EngTex = wsSheet.Range("V28").Value
        FreNam = wsSheet.Range("V29").Value
        FreTex = wsSheet.Range("V30").Value

    '(5d)Creates variables that identifes location of each of the rows with the question part
        TotRows = ARows + BRows + CRows + DRows + 5
        QuesA_row = 2
        QuesB_row = ARows + 3
        QuesC_row = ARows + BRows + 4
        QuesD_row = ARows + BRows + CRows + 5


    '(5e)Create Word table
    Set wdRange = wdDoc.Range
        wdDoc.Tables.Add wdRange, NumRows:=(TotRows), NumColumns:=5, DefaultTableBehavior:=wdWord8TableBehavior, AutoFitBehavior:=wdAutoFitWindow

    Set wdTabl = wdDoc.Tables(1)


    '(5f)Edit Table
    With wdTabl
        .ApplyStyleHeadingRows = False
        .ApplyStyleLastRow = False
        .ApplyStyleFirstColumn = False
        .ApplyStyleLastColumn = True
        .ApplyStyleRowBands = False
        .ApplyStyleColumnBands = False

        'Changes font of table
        .Range.Font.Name = "Arial"
        .Range.Font.Size = "10"

        'Changes spacing of lines in table to single
        .Range.ParagraphFormat.SpaceBeforeAuto = False
        .Range.ParagraphFormat.SpaceBefore = 8
        .Range.ParagraphFormat.SpaceAfterAuto = False
        .Range.ParagraphFormat.SpaceAfter = 0
        .Range.ParagraphFormat.LineSpacingRule = wdLineSpaceSingle
        .Range.ParagraphFormat.PageBreakBefore = False

        'Adjust column widths
        .Columns(1).SetWidth ColumnWidth:=20, RulerStyle:=wdAdjustNone
        .Columns(2).SetWidth ColumnWidth:=23, RulerStyle:=wdAdjustNone
        .Columns(3).SetWidth ColumnWidth:=400, RulerStyle:=wdAdjustNone
        .Columns(4).SetWidth ColumnWidth:=11, RulerStyle:=wdAdjustNone
        .Columns(5).SetWidth ColumnWidth:=40, RulerStyle:=wdAdjustNone

        'Shading for marks column & borders
        .Borders.Enable = False
        .Columns(5).Shading.BackgroundPatternColor = wdColorGray20
        .Columns(5).Borders(wdBorderTop).Color = wdColorBlack
            .Columns(5).Borders(wdBorderTop).LineStyle = Options.DefaultBorderLineStyle
            .Columns(5).Borders(wdBorderTop).LineWidth = Options.DefaultBorderLineWidth
        .Columns(5).Borders(wdBorderLeft).Color = wdColorBlack
            .Columns(5).Borders(wdBorderLeft).LineStyle = Options.DefaultBorderLineStyle
            .Columns(5).Borders(wdBorderLeft).LineWidth = Options.DefaultBorderLineWidth
        .Columns(5).Borders(wdBorderRight).Color = wdColorBlack
            .Columns(5).Borders(wdBorderRight).LineStyle = Options.DefaultBorderLineStyle
            .Columns(5).Borders(wdBorderRight).LineWidth = Options.DefaultBorderLineWidth
        .Columns(5).Borders(wdBorderBottom).Color = wdColorBlack
            .Columns(5).Borders(wdBorderBottom).LineStyle = Options.DefaultBorderLineStyle
            .Columns(5).Borders(wdBorderBottom).LineWidth = Options.DefaultBorderLineWidth
        .Columns(5).Cells(1).Borders(wdBorderBottom).Color = wdColorBlack
            .Columns(5).Cells(1).Borders(wdBorderBottom).LineStyle = Options.DefaultBorderLineStyle
            .Columns(5).Cells(1).Borders(wdBorderBottom).LineWidth = Options.DefaultBorderLineWidth

        'Underlines for questions
        .Columns(3).Cells.Borders.InsideLineStyle = wdLineStyleSingle 'Adds bottom border to all cells in column 3
        .Columns(3).Cells(1).Borders(wdBorderBottom).Color = wdColorWhite 'Removes bottom border
            .Columns(3).Cells(1).Borders(wdBorderBottom).LineStyle = Options.DefaultBorderLineStyle
            .Columns(3).Cells(1).Borders(wdBorderBottom).LineWidth = Options.DefaultBorderLineWidth
        .Columns(3).Cells(QuesA_row).Borders(wdBorderBottom).Color = wdColorWhite 'Removes bottom border
            .Columns(3).Cells(QuesA_row).Borders(wdBorderBottom).LineStyle = Options.DefaultBorderLineStyle
            .Columns(3).Cells(QuesA_row).Borders(wdBorderBottom).LineWidth = Options.DefaultBorderLineWidth
        .Columns(3).Cells(QuesB_row).Borders(wdBorderBottom).Color = wdColorWhite 'Removes bottom border
            .Columns(3).Cells(QuesB_row).Borders(wdBorderBottom).LineStyle = Options.DefaultBorderLineStyle
            .Columns(3).Cells(QuesB_row).Borders(wdBorderBottom).LineWidth = Options.DefaultBorderLineWidth
        .Columns(3).Cells(QuesC_row).Borders(wdBorderBottom).Color = wdColorWhite 'Removes bottom border
            .Columns(3).Cells(QuesC_row).Borders(wdBorderBottom).LineStyle = Options.DefaultBorderLineStyle
            .Columns(3).Cells(QuesC_row).Borders(wdBorderBottom).LineWidth = Options.DefaultBorderLineWidth
        .Columns(3).Cells(QuesD_row).Borders(wdBorderBottom).Color = wdColorWhite 'Removes bottom border
            .Columns(3).Cells(QuesD_row).Borders(wdBorderBottom).LineStyle = Options.DefaultBorderLineStyle
            .Columns(3).Cells(QuesD_row).Borders(wdBorderBottom).LineWidth = Options.DefaultBorderLineWidth
        .Columns(3).Cells(TotRows).Borders(wdBorderBottom).Color = wdColorBlack 'Adds border to bottom row of column
            .Columns(3).Cells(TotRows).Borders(wdBorderBottom).LineStyle = Options.DefaultBorderLineStyle
            .Columns(3).Cells(TotRows).Borders(wdBorderBottom).LineWidth = Options.DefaultBorderLineWidth

        'Enter Data into table
        .Columns(1).Cells(2).Range.Text = QueNum & "."

        .Columns(2).Cells(QuesA_row).Range.Text = PartA
        .Columns(2).Cells(QuesB_row).Range.Text = PartB
        .Columns(2).Cells(QuesC_row).Range.Text = PartC
        .Columns(2).Cells(QuesD_row).Range.Text = PartD

        .Columns(3).Cells(QuesA_row).Range.Text = QueA
        .Columns(3).Cells(QuesB_row).Range.Text = QueB
        .Columns(3).Cells(QuesC_row).Range.Text = QueC
        .Columns(3).Cells(QuesD_row).Range.Text = QueD

        .Columns(5).Cells(1).Range.Text = "Marks"
        .Columns(5).Cells(QuesA_row).Range.Text = MarkA
        .Columns(5).Cells(QuesB_row).Range.Text = MarkB
        .Columns(5).Cells(QuesC_row).Range.Text = MarkC
        .Columns(5).Cells(QuesD_row).Range.Text = MarkD


        'Modifying marks column
        .Columns(5).Cells(1).Range.Font.Bold = True 'Modifys "marks" cell
            .Columns(5).Cells(1).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
            .Columns(5).Cells(1).Range.Cells.VerticalAlignment = wdCellAlignVerticalBottom
        .Columns(5).Cells(QuesA_row).Range.Font.Bold = True
            .Columns(5).Cells(QuesA_row).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
            .Columns(5).Cells(QuesA_row).Range.Cells.VerticalAlignment = wdCellAlignVerticalTop
        .Columns(5).Cells(QuesB_row).Range.Font.Bold = True
            .Columns(5).Cells(QuesB_row).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
            .Columns(5).Cells(QuesB_row).Range.Cells.VerticalAlignment = wdCellAlignVerticalTop
        .Columns(5).Borders(wdBorderTop).Color = wdColorBlack
            .Columns(5).Cells(QuesB_row).Borders(wdBorderTop).LineStyle = Options.DefaultBorderLineStyle
            .Columns(5).Cells(QuesB_row).Borders(wdBorderTop).LineWidth = Options.DefaultBorderLineWidth
        .Columns(5).Cells(QuesC_row).Range.Font.Bold = True
            .Columns(5).Cells(QuesC_row).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
            .Columns(5).Cells(QuesC_row).Range.Cells.VerticalAlignment = wdCellAlignVerticalTop
        .Columns(5).Borders(wdBorderTop).Color = wdColorBlack
            .Columns(5).Cells(QuesC_row).Borders(wdBorderTop).LineStyle = Options.DefaultBorderLineStyle
            .Columns(5).Cells(QuesC_row).Borders(wdBorderTop).LineWidth = Options.DefaultBorderLineWidth
        .Columns(5).Cells(QuesD_row).Range.Font.Bold = True
            .Columns(5).Cells(QuesD_row).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
            .Columns(5).Cells(QuesD_row).Range.Cells.VerticalAlignment = wdCellAlignVerticalTop
        .Columns(5).Borders(wdBorderTop).Color = wdColorBlack
            .Columns(5).Cells(QuesD_row).Borders(wdBorderTop).LineStyle = Options.DefaultBorderLineStyle
            .Columns(5).Cells(QuesD_row).Borders(wdBorderTop).LineWidth = Options.DefaultBorderLineWidth

        'Adjusts text alignment in question column
        .Columns(3).Cells.VerticalAlignment = wdCellAlignVerticalBottom

        ' Exit table and insert page break so next table starts at beginning of page
            With wdRange
                .Collapse Direction:=wdCollapseEnd
                .InsertParagraphAfter
                .InsertBreak Type:=wdPageBreak
                .Collapse Direction:=wdCollapseEnd
            End With
        End With
    Next i


    '(7)Identifies all numbered words and replaces them with all caps bold
    Dim A(10) As String
        A(1) = "one"
        A(2) = "two"
        A(3) = "three"
        A(4) = "four"
        A(5) = "five"
        A(6) = "six"
        A(7) = "seven"
        A(8) = "eight"
        A(9) = "nine"
        A(10) = "ten"

    Set wdRange = ActiveDocument.Content
    With wdRange
        For x = 1 To 10
        .Find.ClearFormatting
        .Find.Replacement.ClearFormatting
        .Find.Replacement.Font.Bold = True
            With .Find
                .Forward = True
                .Wrap = wdFindStop
                .Format = False
                .MatchCase = False
                .MatchWholeWord = True
                .MatchWildcards = False
                .MatchSoundsLike = False
                .MatchAllWordForms = False
                .Replacement.Font.Bold = True
                .Replacement.Font.Allcaps = True

                wdRange.Find.Execute FindText:=A(x), ReplaceWith:=A(x), Format:=True, _
                 Replace:=wdReplaceAll
            End With
        Next x
    End With

    '(8)Null out the variables.
    Set wdCell = Nothing
    Set wdDoc = Nothing
    Set wdApp = Nothing
    Set wdRange = Nothing
    Set wdTabl = Nothing

    '(9) Adds message box to show complete
    MsgBox "Success! The exam questions are complete!", vbInformation


End Sub

Answer 1

这个简化的版本对我有用：

Sub Export_to_Word()

    Dim wdApp As Word.Application, i As Long, wdDoc As Word.Document
    Dim wdCell As Word.Cell, wdTabl As Word.Table, wdRange As Word.Range
    Dim wbBook As Workbook, wsSheet As Worksheet

    Set wbBook = ThisWorkbook
    Set wsSheet = wbBook.Worksheets("Sheet1")

    Set wdApp = New Word.Application
    wdApp.Visible = True
    Set wdDoc = wdApp.Documents.Add

    For i = 1 To 5
        wdDoc.Paragraphs.Add
        Set wdRange = ActiveDocument.Paragraphs.Last.Range

        Set wdTabl = wdDoc.Tables.Add(wdRange, NumRows:=5, NumColumns:=5, _
            DefaultTableBehavior:=wdWord8TableBehavior, _
            AutoFitBehavior:=wdAutoFitWindow)

        With wdTabl
            .Borders.Enable = True
            .Columns(1).Cells(1).Range.Text = "First"
            .Columns(5).Cells(5).Range.Text = "Last"
        End With
    Next i

End Sub

Answer 2

您只设置了一张桌子。

 '(5e)Create Word table
    Set wdRange = wdDoc.Range
        wdDoc.Tables.Add wdRange, NumRows:=(TotRows), NumColumns:=5, DefaultTableBehavior:=wdWord8TableBehavior, AutoFitBehavior:=wdAutoFitWindow

    Set wdTabl = wdDoc.Tables(1)

更改代码。

'(5e)Create Word table
Set wdRange = wdDoc.Range
Set wdTabl = wdDoc.Tables.Add(wdRange, NumRows:=(TotRows), NumColumns:=5, DefaultTableBehavior:=wdWord8TableBehavior, AutoFitBehavior:=wdAutoFitWindow)

'Set wdTabl = wdDoc.Tables(1)