1
Excelの文書から切り離されたセルを単語のカーソル位置にコピーし、定義済みの表スタイルを使用しようとしています。VBAを使用してExcel表からWord表に分解されたセルをコピーする
現在のアクティブなワークシートにコピー＆ペーストするだけでコピー＆ペーストがうまく動作しますが、同じコピー/ペーストを単語から実行しようとすると、テーブル全体が上からコピーされます - 左下には、切り離されたコピー/ペーストを行う代わりに、左下に移動します。
個々の関数とExcel VBAとの間にはいくつかの違いがあることは知っていますが、関数を呼び出すときにライブラリを指定することで回避することができます。以下見
は成功したまとまりのないコピーである：ここでは
は、長さのために編集され、機能してExcelのコードです。 if Copy3内
コードが興味深い部分である：単語VBA、再び長さのために編集に適した以外
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
今ほとんど同じコード：
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と同じコードを使用することは、期待通りに機能しません。
私は常にテーブル全体をコピーします。より具体的には、最も左上のセルから最も右下のセルまで四角形をコピーします。
単語vbaがExcelの同じコピー/貼り付けコマンドを使用するように強制する方法を知っている人はいますか？私が持っていたもう一つのアイデアは、セル用のテーブルセルを埋めることでしたが、コードの再構成がかなり必要になります。助けてくれてありがとう！この1つはあなたが期待されていない場合
個人的に
