使用VBA将Excel表格中的脱节单元复制到Word表格中
我试图从excel文档中复制脱节的单元格到单词中的光标位置，并使用我预定义的表格样式。
当我复制并粘贴到当前活动工作表中时，不相交的复制/粘贴在Excel中很好地工作，但是当我尝试从单词执行相同的复制/粘贴时，它最终从左上angular复制整个表到右下方，而不是做不连贯的复制/粘贴。
我知道从excel VBA到word VBA的单独function有一些区别，但是我认为可以通过在调用函数时指定库来解决这个问题。
下面看到的是一个成功的脱节的副本：
成功的脱节复制
这里是运行的Excel代码，编辑长度。
if Copy3的代码是有趣的部分：
Sub GrabExcelTables() ' !Initializing everything Dim phasesArray As Variant phasesArray = Array("Scoping", "Umsetzung (Dev)", "Go Live") With wsFrom 'Copy schema for tables 1 and 2 ' !Omitted for length 'Copy schema for tables 3 and 4 ' !Omitted for length 'Copy schema for tables 5 and 6 If Copy3 Then 'Iterate through all columns to find which ones are filled For colCounter = Left + 1 To Right - 1 If .Cells(22, colCounter).Value <> "-" Then wantedColumn.Add colCounter End If Next colCounter 'Initialize RangeToCopy with top left cell of table Set RangeToCopy = .Cells(22, Left) 'Iterate through all rows For rowCounter = 22 To 29 'Only check those rows desired ie part of phasesArray If (IsInArray(.Cells(rowCounter, Left).Value, phasesArray) Or rowCounter = 22 Or rowCounter = 29) Then 'Union row phase header Set RangeToCopy = Union(RangeToCopy, .Cells(rowCounter, Left)) 'Add all columns within row that were selected as filled earlier For Each col In wantedColumn Set RangeToCopy = Union(RangeToCopy, .Cells(rowCounter, col)) Next col 'Union final total column Set RangeToCopy = Union(RangeToCopy, .Cells(rowCounter, Right)) End If Next rowCounter End If 'Copy schema for table 7 ' !Omitted for length 'Copy range RangeToCopy.Copy .Range("A42").PasteSpecial Paste:=xlValues End With Set RangeToCopy = Nothing End Sub Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1) End Function
现在几乎相同的代码，除了适应单词VBA，再次编辑长度：
Sub GrabExcelTables() ' !Initializing everything Dim phasesArray As Variant phasesArray = Array("Scoping", "Umsetzung (Dev)", "Go Live") 'specify the workbook to work on WorkbookToWorkOn = ActiveDocument.Path & "\Kalkulationssheet_edit.xlsx" Set oXL = CreateObject("Excel.Application") On Error GoTo Err_Handler 'Open the workbook Set oWB = Workbooks.Open(FileName:=WorkbookToWorkOn) Set wsFrom = oWB.Sheets(7) ' !Initializing everything With wsFrom 'Copy schema for tables 1 and 2 ' !Omitted for length 'Copy schema for tables 3 and 4 ' !Omitted for length 'Copy schema for tables 5 and 6 If Copy3 Then 'Iterate through all columns to find which ones are filled For colCounter = Left + 1 To Right - 1 If .Cells(22, colCounter).Value <> "-" Then wantedColumn.Add colCounter 'MsgBox "Wanted Column: " & colCounter End If Next colCounter 'Initialize RangeToCopy with top left cell of table Set RangeToCopy = .Cells(22, Left) 'Iterate through all rows For rowCounter = 22 To 29 'Only check those rows desired ie part of phasesArray If (IsInArray(.Cells(rowCounter, Left).Value, phasesArray) Or rowCounter = 22 Or rowCounter = 29) Then 'MsgBox "rowCounter: " & rowCounter & "cell value: " & .Cells(rowCounter, Left).Value 'Union row phase header Set RangeToCopy = Excel.Union(RangeToCopy, .Cells(rowCounter, Left)) 'Add all columns within row that were selected as filled earlier For Each col In wantedColumn Set RangeToCopy = Excel.Union(RangeToCopy, .Cells(rowCounter, col)) Next col 'Union final total column Set RangeToCopy = Excel.Union(RangeToCopy, .Cells(rowCounter, Right)) End If Next rowCounter End If 'Copy schema for table 7 ' !Omitted for length 'Copy range 'MsgBox RangeToCopy.Text 'MsgBox RangeToCopy.Value RangeToCopy.Copy '.Range("A42").PasteSpecial Paste:=xlValues End With 'MsgBox Range.Text Selection.PasteExcelTable False, True, False 'Selection.PasteSpecial DataType:=wdPasteRTF Selection.MoveUp Unit:=wdLine, count:=11 Selection.MoveDown Unit:=wdLine, count:=1 ActiveWindow.View.ShowXMLMarkup = wdToggle ActiveDocument.ToggleFormsDesign Selection.Tables(1).Style = "StandardAngebotTable" 'Release object references oWB.Close SaveChanges:=True Set oWB = Nothing Set RangeToCopy = Nothing oXL.Quit Set oXL = Nothing 'quit Exit Sub ' Error Handler Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1) End Function
表格样式的改变和粘贴到正确的位置正如预期的那样工作，但是使用与Excel库调用相同的Excel代码不能按预期的方式工作。
我总是复制整个表格，或者更具体地说，从左上angular的单元格到右下angular的单元格，而不是复制/粘贴。
有没有人知道一种方法来强制word vba使用相同的复制/粘贴命令从Excel中？ 我的另一个想法是填充单元格的表格单元格，但这将需要相当多的代码重构，如果我不需要这样做会很好。 谢谢您的帮助！
就个人而言，我会尝试使用
Selection.PasteSpecial DataType:=wdPasteHTML
要么
Selection.PasteSpecial DataType:=wdPasteOLEObject
代替
Selection.PasteExcelTable False, True, False
如果这个不是你所期望的，那么这个枚举的其他成员是：
