将多个表从选定的Excel范围复制到彼此下面的Word
将多个表从选定的Excel范围复制到彼此下面的Word
提问于 2022-07-10 06:23:10
下面是Excel代码，其目的是复制选定的excel范围，并将其粘贴到当前光标位置下方的下一段Word文档中。
但是，守则也存在一些问题：
如何使用Set WordDoc = WordApp.Documents("Test.docx")设置的word文档，以避免错误地粘贴到另一个文档中？
2-为什么MoveDown的两个实例在显式地将其选项设置为Unit:=wdparagraph, Count:=1, Extend:=wdMove并获得错误时都会失败
运行时错误“4120”：坏参数
Sub CopyTableToWord()
Selection.Copy
Dim WordApp As Object
Set WordApp = GetObject(, "Word.Application")
WordApp.Visible = True
Dim WordDoc As Object
Set WordDoc = WordApp.Documents("Test.docx")
' cursor position
WordApp.Selection.Range.Characters.Last.InsertParagraphAfter
WordApp.Selection.MoveDown 'Unit:=wdparagraph, Count:=1, Extend:=wdMove
With WordApp.Selection
.Range.PasteExcelTable False, False, False
With .Range.Tables(1)
.Range.ParagraphFormat.SpaceBefore = 0
.Range.ParagraphFormat.SpaceAfter = 0
.AutoFitBehavior 2 'wdAutoFitWindow
.Range.Select
End With
' move out of the table, then add space after it
' to move the Word cursor to the new position
' of the next table to be pasted
.Collapse wdCollapseEnd
.Range.InsertParagraphAfter
.MoveDown 'Unit:=wdParagraph, Count:=1, Extend:=wdMove
End With
End Sub回答 1
Stack Overflow用户
回答已采纳
发布于 2022-07-10 22:42:42
如果一次只复制和粘贴一个表，并且只运行一个Word实例，您可以使用如下所示：
Sub PasteAndFormatTableInWord()
Application.ScreenUpdating = False
Dim wdApp As Word.Application, wdDoc As Word.Document
Const StrDocNm As String = "Test.docx"
On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
If wdApp Is Nothing Then Set wdApp = CreateObject("Word.Application")
On Error GoTo 0
With wdApp
'Check if the document is open.
For Each wdDoc In .Documents
If wdDoc.Name = StrDocNm Then Exit For
Next
If wdDoc Is Nothing Then
MsgBox "Your '" & StrDocNm & "' document isn't open." & vbCr & _
"Please open the document and select the insertion point.", vbExclamation: Exit Sub
End If
wdDoc.Activate
With .Selection
.Collapse 1 'wdCollapseStart
With .Range
.PasteAndFormat 16 'wdFormatOriginalFormatting
With .Tables(1)
.AutoFitBehavior 2 'wdAutoFitWindow
.Cell(1, 1).PreferredWidthType = 3 'wdPreferredWidthPoints
.Cell(1, 1).PreferredWidth = 75
.Range.Characters.Last.Next.InsertBefore vbCrLf
End With
.Start = .Tables(1).Range.End + 1
.Collapse 0 'wdCollapseEnd
.Select
End With
End With
wdDoc.Save
End With
Application.ScreenUpdating = False
End Sub页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/72926530
复制相关文章
相似问题
腾讯云开发者
