从Word文档中读取表格的VBA代码
需要帮助修改此VBA代码以从Word文档中读取多个表。它只读取一个表，但我想将多个表导入到同一个Excel表中从Word文档中读取表格的VBA代码,vba,excel,Vba,Excel,需要帮助修改此VBA代码以从Word文档中读取多个表。它只读取一个表，但我想将多个表导入到同一个Excel表中 Sub ImportWordTables() 'Imports a table from Word document Dim wdDoc As Object Dim wdFileName As Variant Dim TableNo As Integer 'number of tables in Word doc D
Sub ImportWordTables()
'Imports a table from Word document
Dim wdDoc As Object
Dim wdFileName As Variant
Dim TableNo As Integer 'number of tables in Word doc
Dim iTable As Integer 'table number index
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(wdFileName) '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
您可以使用此命令对文档中的每个表执行某些操作：
Dim oTbl As Table
For Each oTbl In ActiveDocument.Tables
' Do something
Debug.Print oTbl.Columns.Count & " " & oTbl.Rows.Count
Next
Sub UserChosenTables()
Dim oTbl As Table
Dim sTemp As String
Dim aTables() As String
Dim x As Long
sTemp = InputBox("Which tables", "Select tables")
If Len(sTemp) = 0 Then ' user entered nothing
Exit Sub
End If
aTables = Split(sTemp, ",")
' of course you'll want to add more code to CYA in case the user
' asks for a table that's not there or otherwise enters something silly.
' You might also want to let them enter e.g. ALL if they want you to do all of them
' (but don't know how many there are)
For x = LBound(aTables) To UBound(aTables)
Set oTbl = ActiveDocument.Tables(CLng(aTables(x)))
' do [whatever] with table here
Debug.Print oTbl.Columns.Count & " " & oTbl.Rows.Count
Next
End Sub
这就是代码，但它不能完全回答我的问题。 我只需要pdf中的表格
Sub Imp_Into_XL(PDF_File As String, Each_Sheet As Boolean)
'This procedure get the PDF data into excel by following way
'1.Open PDF file
'2.Looping through pages
'3.get the each PDF page data into individual _
sheets or single sheet as defined in Each_Sheet Parameter
Dim AC_PD As Acrobat.AcroPDDoc 'access pdf file
Dim AC_Hi As Acrobat.AcroHiliteList 'set selection word count
Dim AC_PG As Acrobat.AcroPDPage 'get the particular page
Dim AC_PGTxt As Acrobat.AcroPDTextSelect 'get the text of selection area
Dim WS_PDF As Worksheet
Dim RW_Ct As Long 'row count
Dim Col_Num As Integer 'column count
Dim Li_Row As Long 'Maximum rows limit for one column
Dim Yes_Fir As Boolean 'to identify beginning of page
Li_Row = Rows.Count
Dim Ct_Page As Long 'count pages in pdf file
Dim i As Long, j As Long, k As Long 'looping variables
Dim T_Str As String
Dim Hld_Txt As Variant 'get PDF total text into array
RW_Ct = 0 'set the intial value
Col_Num = 1 'set the intial value
Application.ScreenUpdating = False
Set AC_PD = New Acrobat.AcroPDDoc
Set AC_Hi = New Acrobat.AcroHiliteList
'set maximum selection area of PDF page
AC_Hi.Add 0, 32767
With AC_PD
'open PDF file
.Open PDF_File
'get the number of pages of PDF file
Ct_Page = .GetNumPages
'if get pages is failed exit sub
If Ct_Page = -1 Then
MsgBox "Pages Cannot determine in PDF file '" & PDF_File & "'"
.Close
GoTo h_end
End If
'add sheet only one time if Data retrive in one sheet
If Each_Sheet = False Then
Set WS_PDF = Worksheets.Add(, Worksheets(Sheets.Count))
WS_PDF.Name = "PDF3Text"
End If
'looping through sheets
For i = 1 To Ct_Page
T_Str = ""
'get the page
Set AC_PG = .AcquirePage(i - 1)
'get the full page selection
Set AC_PGTxt = AC_PG.CreateWordHilite(AC_Hi)
'if text selected successfully get the all the text into T_Str string
If Not AC_PGTxt Is Nothing Then
With AC_PGTxt
For j = 0 To .GetNumText - 1
T_Str = T_Str & .GetText(j)
Next j
End With
End If
If Each_Sheet = True Then
'add each sheet for each page
Set WS_PDF = Worksheets.Add(, Worksheets(Sheets.Count))
End If
'transfer PDF data into sheet
With WS_PDF
If Each_Sheet = True Then
.Name = "Page-" & i
'get the PDF data into each sheet for each PDF page
'if text accessed successfully then split T_Str by VbCrLf
'and get into array Hld_Txt and looping through array and fill sheet with PDF data
If T_Str <> "" Then
Hld_Txt = Split(T_Str, vbCrLf)
For k = 0 To UBound(Hld_Txt)
T_Str = CStr(Hld_Txt(k))
If Left(T_Str, 1) = "=" Then T_Str = "'" & T_Str
.Cells(k + 1, 1).Value = T_Str
Next k
Else
'information if text not retrive from PDF page
.Cells(1, 1).Value = "No text found in page " & i
End If
Else
'get the pdf data into single sheet
If T_Str <> "" Then
Hld_Txt = Split(T_Str, vbCrLf)
Yes_Fir = True
For k = 0 To UBound(Hld_Txt)
RW_Ct = RW_Ct + 1
'check begining of page if yes enter PDF page number for any idenfication
If Yes_Fir Then
RW_Ct = RW_Ct + 1
.Cells(RW_Ct, Col_Num).Value = "Text In Page - " & i
RW_Ct = RW_Ct + 2
Yes_Fir = False
End If
'check for maximum rows if exceeds start from next column
If RW_Ct > Li_Row Then
RW_Ct = 1
Col_Num = Col_Num + 1
End If
T_Str = CStr(Hld_Txt(k))
If Left(T_Str, 1) = "=" Then T_Str = "'" & T_Str
.Cells(RW_Ct, Col_Num).Value = T_Str
Next k
Else
RW_Ct = RW_Ct + 1
.Cells(RW_Ct, Col_Num).Value = "No text found in page " & i
RW_Ct = RW_Ct + 1
End If
End If
End With
Next i
.Close
End With
Application.ScreenUpdating = True
MsgBox "Imported"
h_end:
Set WS_PDF = Nothing
Set AC_PGTxt = Nothing
Set AC_PG = Nothing
Set AC_Hi = Nothing
Set AC_PD = Nothing
End Sub
将\u子导入到\u XL中（PDF\u文件为字符串，每个\u表为布尔值）
'此过程通过以下方式将PDF数据导入excel
'1.打开PDF文件
“2.循环浏览页面
'3.将每个PDF页面的数据放入单个_
每个图纸参数中定义的图纸或单个图纸
以Acrobat.AcroPDDoc访问pdf文件的形式将AC_PD调暗
Dim AC_Hi作为Acrobat.AcrohilitList设置选择字数
将Acrobat.AcroPDPage的AC_PG调暗为“获取特定页面”
将Acrobat.AcroPDTextSelect作为Acrobat.AcroPDTextSelect设置为Dim AC_PGTxt获取选择区域的文本
Dim WS_PDF作为工作表
尺寸RW\U Ct作为长行计数
Dim Col_Num作为整数的列计数
Dim Li_Row As Long“一列的最大行数限制”
Dim Yes_Fir为布尔值以标识页面的开头
行=行。计数
将Ct_页面变暗为长“在pdf文件中计数页面
Dim i为Long，j为Long，k为Long'循环变量
作为字符串的Dim T_Str
Dim Hld_Txt作为变量“将PDF总文本放入数组”
RW_Ct=0'设置初始值
Col_Num=1'设置初始值
Application.ScreenUpdating=False
设置AC_PD=New Acrobat.AcroPDDoc
设置AC_Hi=新Acrobat.AcrohilitList
'设置PDF页面的最大选择区域
AC_Hi.Add 0，32767
与AC_PD
'打开PDF文件
.打开PDF\u文件
'获取PDF文件的页数
Ct\U页面=.GetNumPages
'如果获取页面失败，请退出sub
如果Ct_Page=-1，则
MsgBox“页面无法在PDF文件中确定”&&PDF_文件&“
.结束
去胡端
如果结束
'如果在一张工作表中检索数据，则只添加一次工作表
如果每张表均为假，则
设置WS_PDF=Worksheets.Add（，Worksheets（Sheets.Count））
WS_PDF.Name=“PDF3Text”
如果结束
"翻纸",
对于i=1至Ct\U页面
T_Str=“”
“拿到那一页
设置AC_PG=.AcquirePage（i-1）
'获取完整的页面选择
设置AC_PGTxt=AC_PG.CreateWordHilite（AC_Hi）
'如果成功选择文本，则将所有文本转换为T_Str字符串
如果不是AC_PGTxt，则为空
使用AC_PGTxt
对于j=0到.GetNumText-1
T_Str=T_Str&GetText（j）
下一个j
以
如果结束
如果每个表均为真，则
'为每页添加每页
设置WS_PDF=Worksheets.Add（，Worksheets（Sheets.Count））
如果结束
'将PDF数据传输到工作表中
使用WS_PDF
如果每个表均为真，则
.Name=“第页-”&i
'将PDF数据放入每个PDF页面的每个工作表中
'如果文本访问成功，则按VbCrLf拆分T_Str
'并进入数组Hld_Txt，在数组中循环并用PDF数据填充表单
如果T_Str“”那么
Hld_Txt=拆分（T_Str，vbCrLf）
对于k=0到UBound（Hld_Txt）
T_Str=CStr（Hld_Txt（k））
如果左（T_Str，1）=“=”则T_Str=“””&T_Str
.Cells（k+1,1）。值=T_Str
下一个k
其他的
'未从PDF页面检索文本时的信息
.Cells（1，1）.Value=“在第页中找不到文本”&i
如果结束
其他的
'将pdf数据放在一张纸中
如果T_Str“”那么
Hld_Txt=拆分（T_Str，vbCrLf）
是的
对于k=0到UBound（Hld_Txt）
RW\U Ct=RW\U Ct+1
'如果是，请检查页面的开头输入任何标识的PDF页码
如果是，那么
RW\U Ct=RW\U Ct+1
.Cells（RW\u Ct，Col\u Num）.Value=“第页中的文本-”&i
RW\U Ct=RW\U Ct+2
是(Fir=假)
如果结束
'如果超过从下一列开始的行数，请检查最大行数
如果RW\U Ct>Li\U Row，则
RW_Ct=1
列数=列数+1
如果结束
T_Str=CStr（Hld_Txt（k））
如果左（T_Str，1）=“=”则T_Str=“””&T_Str
.Cells（RW\u Ct，Col\u Num）.Value=T\u Str
下一个k
其他的
RW\U Ct=RW\U Ct+1
.Cells（RW\u Ct，Col\u Num）.Value=“在第页中找不到文本”&i
RW\U Ct=RW\U Ct+1
如果结束
如果结束
以
接下来我
.结束
以
Application.ScreenUpdating=True
MsgBox“已导入”
完:
设置WS_PDF=Nothing
设置AC_PGTxt=无
设置AC_PG=无
设置AC_Hi=无
设置AC_PD=无
端接头