2017-07-21 13 views
0

特定のMicrosoft Word文書から特定の表を特定のExcelシートにインポートしようとしています。特定のWord文書から特定のExcel文書に単語をインポートする

テーブルが特定のワードドキュメントにあり、それを正しいExcelシートのExcelセル範囲E8:N21に貼り付けようとしています。

私は以下のコードを適応しますが、継続的に取得してきた問題:今

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 

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(wdHuddle) 'open Word file 

With wdDoc 
TableNo = 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 table number of table to import", "Import Word Table", "1") 
End If 
With .tables(TableNo) 
'copy cell contents from Word table cells to Excel cells 
For iRow = 1 To .Rows.Count 
For iCol = 1 To .Columns.Count 
Cells(iRow, iCol) = WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text) 
Next iCol 
Next iRow 
End With 
End With 

Set wdDoc = Nothing 

End Sub 

が、それはまた、正しい単語の文書をインポートするよう要求しますが、それはいつものテーブルを引っ張ってくるように、その必要はありません特定の場所からの同じ単語の文書

答えて

0

以下は、あなたが要求するコードとそれが実行されていることを示すアニメーションGIFです。 fNameをWord文書の完全なパスに置き換えて、行の&の列開始位置をforループのiCol = 5、iRow = 9(E9)に変更するだけです。

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 fName As String 

'============= PLACE YOUR WORD DOCUMENT PATH HERE ================= 
fName = "\\vmware-host\Shared Folders\Desktop\Test.docx" 

Set wdDoc = GetObject(fName) 'open Word file 

With wdDoc 
TableNo = 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 table number of table to import", "Import Word Table", "1") 
End If 
With .tables(TableNo) 
'copy cell contents from Word table cells to Excel cells 
For iRow = 1 To .Rows.Count 
For iCol = 1 To .Columns.Count 
Cells(iRow, iCol) = WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text) 
Next iCol 
Next iRow 
End With 
End With 

Set wdDoc = Nothing 

End Sub 

enter image description here

関連する問題