1
Excel 표의 셀을 단어의 커서 위치로 복사하고 미리 정의 된 표 스타일을 사용하려고합니다.VBA를 사용하여 Excel 표에서 Word 표로 Word 표로 복사
복사/붙여 넣기가 현재 활성 워크 시트로 복사 할 때 Excel에서 훌륭하게 작동하지만 단어에서 동일한 복사/붙여 넣기를 실행하자마자 전체 테이블이 맨 위에서 복사됩니다. - 왼쪽 하단으로 연결하면 복사/붙여 넣기가 끊어집니다.
Excel에서 VBA의 개별 기능 간에는 몇 가지 차이점이 있지만 기능을 호출 할 때 라이브러리를 지정하여이를 해결할 수 있다고 생각했습니다.
여기 
이 기능은 길이 편집 코드를 엑셀입니다 : 아래와
가 성공적으로 연결되지 않은 복사본입니다.
if Copy3 내의 코드가 흥미로운 부분입니다 :
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
테이블 스타일의 변화와 : 다시 길이 편집, 워드 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
거의 동일한 코드 올바른 위치에 붙여 넣기는 정확히 예상대로 작동하지만 Excel 라이브러리 호출에서 Excel과 동일한 코드를 사용하면 예상대로 작동하지 않습니다.
좋은 분리 된 복사/붙여 넣기를 얻는 대신, 항상 전체 표를 지나치거나, 특히 가장 왼쪽 상단 셀에서 가장 오른쪽 하단 셀까지 직사각형을 복사합니다.
누구나 단어 vba가 Excel의 동일한 복사/붙여 넣기 명령을 사용하도록하는 방법을 알고 있습니까? 내가 가지고있는 또 다른 아이디어는 셀을위한 테이블 셀을 채우기위한 것이 었습니다.하지만 코드 구조가 상당히 필요했습니다. 그렇게하지 않으면 좋을 것입니다. 도와 주셔서 감사합니다!
