Excel VBA에서 Word 표 서식 유지

Question

다른 토론에서 Word에서 Excel로 표를 가져 오는이 매크로를 찾을 수있었습니다.

잘 작동하지만 어떻게 Word 표의 형식을 유지할 수 있습니까?

몇 가지 방법을 시도했지만 제대로 작동하지 않습니다. 한 번에 1 개가 아닌 여러 파일을 동시에 수행 할 수있는 방법이 있습니까?

Option Explicit 

Sub ImportWordTable() 

Dim wdDoc As Object 
Dim wdFileName As Variant 
Dim tableNo As Integer 'table number in Word 
Dim iRow As Long 'row index in Excel 
Dim iCol As Integer 'column index in Excel 
Dim resultRow As Long 
Dim tableStart As Integer 
Dim tableTot As Integer 

On Error Resume Next 

ActiveSheet.Range("A:AZ").ClearContents 

wdFileName = Application.GetOpenFilename("Word files (*.doc),*.doc", , _ 
"Browse for file containing table to be imported") 

If wdFileName = False Then Exit Sub '(user cancelled import file browser) 

Set wdDoc = GetObject(wdFileName) 'open Word file 

With wdDoc 
    tableNo = wdDoc.tables.Count 
    tableTot = wdDoc.tables.Count 
    If tableNo = 0 Then 
     MsgBox "This document contains no tables", _ 
     vbExclamation, "Import Word Table" 
    ElseIf tableNo > 1 Then 
     tableNo = InputBox("This Word document contains " & tableNo & " tables." & vbCrLf & _ 
     "Enter the table to start from", "Import Word Table", "1") 
    End If 

    resultRow = 4 

    For tableStart = 1 To tableTot 
     With .tables(tableStart) 
      'copy cell contents from Word table cells to Excel cells 
      For iRow = 1 To .Rows.Count 
       For iCol = 1 To .Columns.Count 
        Cells(resultRow, iCol) = WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text) 
       Next iCol 
       resultRow = resultRow + 1 
      Next iRow 
     End With 
     resultRow = resultRow + 1 
    Next tableStart 
End With 

End Sub 

Answer 1

동일한 디렉토리에있는 여러 문서의 형식이 포함 된 표를 복사하십시오.

Sub ImportWordTable() 

    Dim WordApp As Object 
    Dim WordDoc As Object 
    Dim arrFileList As Variant, FileName As Variant 
    Dim tableNo As Integer       'table number in Word 

    Dim tableStart As Integer 
    Dim tableTot As Integer 
    Dim Target As Range 

    'On Error Resume Next 

    arrFileList = Application.GetOpenFilename("Word files (*.doc; *.docx),*.doc;*.docx", 2, _ 
               "Browse for file containing table to be imported", , True) 

    If Not IsArray(arrFileList) Then Exit Sub   '(user cancelled import file browser) 

    Set WordApp = CreateObject("Word.Application") 
    WordApp.Visible = True 

    Range("A:AZ").ClearContents 
    Set Target = Range("A1") 

    For Each FileName In arrFileList 
     Set WordDoc = WordApp.Documents.Open(FileName, ReadOnly:=True) 

     With WordDoc 
      tableNo = WordDoc.tables.Count 
      tableTot = WordDoc.tables.Count 
      If tableNo = 0 Then 
       MsgBox WordDoc.Name & " contains no tables", vbExclamation, "Import Word Table" 

      ElseIf tableNo > 1 Then 
       tableNo = InputBox(WordDoc.Name & " contains " & tableNo & " tables." & vbCrLf & _ 
            "Enter the table to start from", "Import Word Table", "1") 
      End If 

      For tableStart = 1 To tableTot 
       With .tables(tableStart) 
        .Range.Copy 
        'Target.Parent.PasteSpecial Format:="Text", Link:=False, DisplayAsIcon:=False 
        Target.Activate 
        ActiveSheet.Paste 

        Set Target = Target.Offset(.Rows.Count + 2, 0) 
       End With 
      Next tableStart 

      .Close False 
     End With 

    Next FileName 

    WordApp.Quit 

    Set WordDoc = Nothing 
    Set WordApp = Nothing 
End Sub 

Answer 2

당신은 방금 말씀에서 전체 테이블을 복사 한 다음 Worksheet의 PasteSpecial 방법을 사용하여 Excel에서 붙여 넣을 수 있습니다. Worksheet의 PasteSpecial 메서드는 Range 메서드에 대한 옵션이 다릅니다. 이 옵션 중 하나는 Format이고 HTML 설정은 Word 테이블의 형식을 붙여 넣을 Excel 범위에 적용합니다.

Worksheet의 방법은 활성 셀을 사용하기 때문에 Select 대상이 먼저 Range이어야합니다. 약간 추한 것 같지만 대안이 보이지 않습니다. 여기

은 예입니다 :

Option Explicit 

Sub Test() 
    Dim rngTarget As Range 

    Set rngTarget = ThisWorkbook.Worksheets("Sheet1").Range("A1") 

    WordTableToExcel "C:\Users\Robin\Desktop\foo1.docx", 1, rngTarget 

End Sub 

Sub WordTableToExcel(strWordFile As String, intWordTableIndex As Integer, rngTarget As Range) 

    Dim objWordApp As Object 
    Dim objWordTable As Object 

    On Error GoTo CleanUp 

    'get table from word document 
    Set objWordApp = GetObject(strWordFile) 
    Set objWordTable = objWordApp.Tables(intWordTableIndex) 
    objWordTable.Range.Copy 

    'paste table to sheet 
    rngTarget.Select 
    rngTarget.Parent.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False 

CleanUp: 
    'clean up word references 
    Set objWordTable = Nothing 
    Set objWordApp = Nothing 

End Sub 

여러 파일에 적용하는 방법에 대한 질문에 대해서 - 당신은 단지마다 해당 문서의 테이블 이상이 재사용 가능한 Sub 각 단어에 대한 문서를 계속 전화하고 반복 할 수 루프를 기존 코드에서 사용할 수 있습니다.