Question

我正在尝试将脱离文档中的脱节单元格复制到单词中的光标位置，并使用我预定义的表格样式。

当我复制并粘贴到当前活动工作表时，不相交的复制/粘贴在excel中运行良好，但是当我尝试从word执行相同的复制/粘贴时，它最终会从顶部复制整个表格 - 一直走到右下角，而不是做脱节的复制/粘贴。

我知道从excel VBA到单词VBA的单个函数之间存在一些差异，但我认为通过在调用函数时指定库可以解决这个问题。

下面是一个成功的脱节副本：

这是有效的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 i.e.  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 i.e.  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库调用完全相同的代码无法按预期运行。

我总是复制整个表格，或者更具体地说是从左上角的大多数单元格到最右下角的单元格，而不是获得一个漂亮的脱节复制/粘贴。

有没有人知道强制word vba使用excel中相同的复制/粘贴命令的方法？我的另一个想法是填充表格单元格的单元格，但这需要相当多的代码重组，如果我不需要这样做会很好。谢谢你的帮助！

Answer 1

就个人而言，我尝试使用
Selection.PasteSpecial DataType:=wdPasteHTML
或
Selection.PasteSpecial DataType:=wdPasteOLEObject
而不是 Selection.PasteExcelTable False, True, False

如果这不是你所期望的，那么这是Enum的其他成员：

使用VBA将脱节的单元格从Excel表格复制到Word表格

1 个答案: