使用 VBA 将没有清理功能的 table 从 word 导入到 excel
Import table without clean function from word to excel using VBA
下面的代码仅将 table 中的值从 Word 复制到 Excel。有没有其他方法可以将整个 table(包括边框等格式)复制到 excel?
Public Sub ImportTable()
Dim wdDoc As Object
Dim wdFileName As Variant
Dim TableNo As Integer 'table number in Word
Dim iRow As Long 'row index in Word
Dim jRow As Long 'row index in Excel
Dim iCol As Integer 'column index in Excel
wdFileName = Application.GetOpenFilename("All Word Documents (*.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
If wdDoc.tables.Count = 0 Then
MsgBox "This document contains no tables", _
vbExclamation, "Import Word Table"
Else
jRow = 0
Sheets.Add After:=Sheets(Worksheets.Count)
For TableNo = 1 To wdDoc.tables.Count
With .tables(TableNo)
'copy cell contents from Word table cells to Excel cells
For iRow = 1 To .Rows.Count
jRow = jRow + 1
For iCol = 1 To .Columns.Count
On Error Resume Next
ActiveSheet.Cells(jRow, iCol) = WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text)
On Error GoTo 0
Next iCol
Next iRow
End With
jRow = 0
Sheets.Add After:=Sheets(Worksheets.Count)
Next TableNo
End If
End With
Set wdDoc = Nothing
End Sub
*此代码来源于网络
我想你可以 copy/paste...
Sheets.Add After:=Sheets(Worksheets.Count)
For TableNo = 1 To wdDoc.tables.Count
.tables(TableNo).Range.Copy
With ActiveSheet.Range("a1")
.PasteSpecial
.Select
End With
Sheets.Add After:=Sheets(Worksheets.Count)
Next TableNo
但是,如果您想避免创建额外的 sheet,请尝试以下操作...
For TableNo = 1 To wdDoc.tables.Count
Sheets.Add After:=Sheets(Worksheets.Count)
.tables(TableNo).Range.Copy
With ActiveSheet.Range("a1")
.PasteSpecial
.Select
End With
Next TableNo
下面的代码仅将 table 中的值从 Word 复制到 Excel。有没有其他方法可以将整个 table(包括边框等格式)复制到 excel?
Public Sub ImportTable()
Dim wdDoc As Object
Dim wdFileName As Variant
Dim TableNo As Integer 'table number in Word
Dim iRow As Long 'row index in Word
Dim jRow As Long 'row index in Excel
Dim iCol As Integer 'column index in Excel
wdFileName = Application.GetOpenFilename("All Word Documents (*.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
If wdDoc.tables.Count = 0 Then
MsgBox "This document contains no tables", _
vbExclamation, "Import Word Table"
Else
jRow = 0
Sheets.Add After:=Sheets(Worksheets.Count)
For TableNo = 1 To wdDoc.tables.Count
With .tables(TableNo)
'copy cell contents from Word table cells to Excel cells
For iRow = 1 To .Rows.Count
jRow = jRow + 1
For iCol = 1 To .Columns.Count
On Error Resume Next
ActiveSheet.Cells(jRow, iCol) = WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text)
On Error GoTo 0
Next iCol
Next iRow
End With
jRow = 0
Sheets.Add After:=Sheets(Worksheets.Count)
Next TableNo
End If
End With
Set wdDoc = Nothing
End Sub
*此代码来源于网络
我想你可以 copy/paste...
Sheets.Add After:=Sheets(Worksheets.Count)
For TableNo = 1 To wdDoc.tables.Count
.tables(TableNo).Range.Copy
With ActiveSheet.Range("a1")
.PasteSpecial
.Select
End With
Sheets.Add After:=Sheets(Worksheets.Count)
Next TableNo
但是,如果您想避免创建额外的 sheet,请尝试以下操作...
For TableNo = 1 To wdDoc.tables.Count
Sheets.Add After:=Sheets(Worksheets.Count)
.tables(TableNo).Range.Copy
With ActiveSheet.Range("a1")
.PasteSpecial
.Select
End With
Next TableNo