将 excel 中的单元格数组复制并粘贴到单词占位符
Copy and paste array of cells from excel to word placeholder
我想使用 VBA 从 Excel 复制一组单元格并将它们复制到 word 文档中的占位符文本中。我已经编写了以下代码,但它不起作用。任何帮助都会被拒绝。到目前为止,这是我的代码:
Sub dataToWord()
Dim Wbk As Workbook: Set Wbk = ThisWorkbook
Dim Wrd As New Word.Application
Wrd.Visible = True
Dim WDoc As Document
Set WDoc = Wrd.Documents.Open(ThisWorkbook.Path & "\" & Range("E1").Value & ".doc") 'Location of word doc.
With WDoc.Content.Find ' Perform find and replace, does not work
.Execute FindText:="<Grid1>", ReplaceWith:=Range(A2:F33).Value, Replace:=wdReplaceAll
End With
'Save and clean up
WDoc.Save
WDoc.Close
Wrd.Quit
End Sub
Option Explicit
Sub dataToWord()
Dim Wbk As Workbook: Set Wbk = ThisWorkbook
Dim Wrd As New Word.Application
Dim tbl As Excel.Range
Wrd.Visible = True
Dim WDoc As Document
Dim Find1stRange As Word.Range
Set WDoc = Wrd.Documents.Open(ThisWorkbook.Path & "\" & Range("E1").Value & ".docx") 'Location of word doc.
' With WDoc.Content.Find ' Perform find and replace, does not work
' .Execute FindText:="<Grid1>", ReplaceWith:=Range(A2:F33).Value, Replace:=wdReplaceAll
' End With
'Define Range in Excel
Set tbl = ThisWorkbook.Worksheets(1).Range("A2:F33")
Set Find1stRange = WDoc.Range
With Find1stRange.Find
.Text = "<Grid1>"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Find1stRange.Find.Execute
'Copy Excel Table Range
tbl.Copy
'Paste Table into MS Word
Find1stRange.Paragraphs(1).Range.PasteExcelTable _
LinkedToExcel:=False, _
WordFormatting:=False, _
RTF:=False
' Autofit Table so it fits inside Word Document
' Dim WordTable as object
' Set WordTable = WDoc.Tables(1)
' WordTable.AutoFitBehavior (wdAutoFitWindow)
'Save and clean up
WDoc.Save
WDoc.Close
Wrd.Quit
End Sub
我想使用 VBA 从 Excel 复制一组单元格并将它们复制到 word 文档中的占位符文本中。我已经编写了以下代码,但它不起作用。任何帮助都会被拒绝。到目前为止,这是我的代码:
Sub dataToWord()
Dim Wbk As Workbook: Set Wbk = ThisWorkbook
Dim Wrd As New Word.Application
Wrd.Visible = True
Dim WDoc As Document
Set WDoc = Wrd.Documents.Open(ThisWorkbook.Path & "\" & Range("E1").Value & ".doc") 'Location of word doc.
With WDoc.Content.Find ' Perform find and replace, does not work
.Execute FindText:="<Grid1>", ReplaceWith:=Range(A2:F33).Value, Replace:=wdReplaceAll
End With
'Save and clean up
WDoc.Save
WDoc.Close
Wrd.Quit
End Sub
Option Explicit
Sub dataToWord()
Dim Wbk As Workbook: Set Wbk = ThisWorkbook
Dim Wrd As New Word.Application
Dim tbl As Excel.Range
Wrd.Visible = True
Dim WDoc As Document
Dim Find1stRange As Word.Range
Set WDoc = Wrd.Documents.Open(ThisWorkbook.Path & "\" & Range("E1").Value & ".docx") 'Location of word doc.
' With WDoc.Content.Find ' Perform find and replace, does not work
' .Execute FindText:="<Grid1>", ReplaceWith:=Range(A2:F33).Value, Replace:=wdReplaceAll
' End With
'Define Range in Excel
Set tbl = ThisWorkbook.Worksheets(1).Range("A2:F33")
Set Find1stRange = WDoc.Range
With Find1stRange.Find
.Text = "<Grid1>"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Find1stRange.Find.Execute
'Copy Excel Table Range
tbl.Copy
'Paste Table into MS Word
Find1stRange.Paragraphs(1).Range.PasteExcelTable _
LinkedToExcel:=False, _
WordFormatting:=False, _
RTF:=False
' Autofit Table so it fits inside Word Document
' Dim WordTable as object
' Set WordTable = WDoc.Tables(1)
' WordTable.AutoFitBehavior (wdAutoFitWindow)
'Save and clean up
WDoc.Save
WDoc.Close
Wrd.Quit
End Sub