Excel提取Word表格内容。小白练手
<div class="blockcode"><blockquote>'wdCell12单元格。'wdCharacter 1 字符。
'wdCharacterFormatting 13字符格式。
'wdColumn 9 列。
'wdItem16所选项。
'wdLine5 一个线段。
'wdParagraph 4 段落。
'wdParagraphFormatting 14段落格式。
'wdRow 10行。
'wdScreen 7 屏幕尺寸。
'wdSection 8 一节。
'wdSentence3 句子。
'wdStory 6 部分。
'wdTable 15一个表格。
'wdWindow 11窗口。
'wdWord2 字。
'Expand 扩展
Sub 提取报告工作量稳定版()
Dim a, myrang
'搜索工作量表格关键字
str1 = "建筑物数量"
Set wdapp = CreateObject("word.application")
'Word窗口显示开
wdapp.Visible = True
'选择文件夹
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show Then mypath = .SelectedItems(1) Else Exit Sub '打开目标文件夹
End With
'文件地址加“\”
mypath = mypath & "\"
'从第几行开始写入
r = 2
'Dir文档名称
myfile = Dir(mypath)
'检查后缀打开文档
Do While myfile <> ""
If Right(UCase(myfile), 4) = ".DOC" Or Right(UCase(myfile), 4) = "DOCX" Then '检查扩展名是否为Word文件
Set wddoc = wdapp.Documents.Open(mypath & myfile) '打开文件
'写入文档名称
Cells(r, 1) = myfile
'激活文档
Set myrange = wdapp.ActiveDocument.Content
'查找str1
With myrange.Find
.Text = str1
.Forward = True
.Execute
If .Found = True Then
myrange.Select
'wdapp.Selection.Move unit:=10, Count:=1
'wdapp.Selection.Expand unit:=10
'MsgBox (wdapp.Selection.Text)
'MsgBox (wdapp.Selection.tables(1).Columns.Count)
For i = 1 To wdapp.Selection.tables(1).Columns.Count
Cells(r, i + 1).Value = wdapp.Selection.tables(1).Cell(2, i).Range.Text 'Word表格的内容通过该方法获取
Cells(r, i + 1).Value = Left(Cells(r, i + 1).Value, Len(Cells(r, i + 1).Value) - 1) '去除获取内容末尾的黑点(左长度减1来实现)
Next i
Cells(r, i + 1).Value = wdapp.ActiveDocument.Paragraphs(1).Range.Text
Cells(r, i + 1).Value = Left(Cells(r, i + 1).Value, Len(Cells(r, i + 1).Value) - 1)
'Cells(CellsR, CellsC).Value = wdapp.Selection.tables.Count.Cell(1, 1).Range.Text 'Word表格的内容通过该方法获取
'Cells(CellsR, CellsC).Value = Left(Cells(CellsR, CellsC).Value, Len(Cells(CellsR, CellsC).Value) - 1) '去除获取内容末尾的黑点
'Cells(r, 2).Value = wdapp.Selection.Text
'Cells(r, 3) = Selection.Text
'For Each i In ActiveDocument.Paragraphs
Else
Cells(r, 2) = "报告内没有此字符"
End If
End With
r = r + 1
wddoc.Close
End If
myfile = Dir()
Loop
wdapp.Quit
MsgBox ("提取出的数据不能进行统计计算" & Chr(10) & "如需统计和计算请另行处理" & Chr(10) & "（可以粘贴到Word再粘贴回Excel）")
End Sub
本小白练手的习题，没看过vb.net，只能用VB宏运行速度慢，如有大神路过请指教优化。 高手可以加我qq吗3298554767 我也是小白，只是在论坛学了点皮毛中的皮毛，提高了自己一点点的工作效率！ 谢谢分享，下载尝试下
页:
[1]