将多个表从excel导出到word时覆盖的表
我正在尝试使用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
2 个答案:
答案 0 :(得分：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
答案 1 :(得分：0)
您只设置了一个表格。
'(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)
相关问题
最新问题
- 我写了这段代码，但我无法理解我的错误
- 我无法从一个代码实例的列表中删除 None 值，但我可以在另一个实例中。为什么它适用于一个细分市场而不适用于另一个细分市场？
- 是否有可能使 loadstring 不可能等于打印？卢阿
- java中的random.expovariate()
- Appscript 通过会议在 Google 日历中发送电子邮件和创建活动
- 为什么我的 Onclick 箭头功能在 React 中不起作用？
- 在此代码中是否有使用“this”的替代方法？
- 在 SQL Server 和 PostgreSQL 上查询，我如何从第一个表获得第二个表的可视化
- 每千个数字得到
- 更新了城市边界 KML 文件的来源？