找回密码
 立即注册
搜索

原创:提取文档表格(宏)

2
回复
307
查看
[复制链接]

18

主题

220

帖子

45

幻币

一流武者

Rank: 3Rank: 3

积分
280
QQ
2016-4-12 12:06:41 显示全部楼层 |阅读模式
一些能从文档中提取表格和图片的软件和插件很多。但大多不是免费的。以下是我在Word环境用VBA编写的宏,该程序的特点有:从Word中提取所有表格;每个表格之前进行编号;新建文件名易于识别文件来源、表格数。
Sub TableCollect ()
If MsgBox("将本文档中的表格提取到新文档,继续吗?", vbOKCancel + vbInformation, "提取表格") = vbOK Then
If ActiveDocument.Tables.Count >= 1 Then
tbcnt = ActiveDocument.Tables.Count
a = ActiveDocument.Name
Documents.Add DocumentType:=wdNewBlankDocument
b = ActiveDocument.Name
Windows(a).Activate
For tb = 1 To ActiveDocument.Tables.Count
ActiveDocument.Tables(tb).Select
Selection.Copy
Windows(b).Activate
Selection.TypeText Text:="Table - " & tb & " of " & tbcnt
Selection.TypeParagraph
Selection.Paste
Windows(a).Activate
Next
Windows(b).Activate
a = Mid(a, 1, Len(a) - 4)
ChangeFileOpenDirectory "C:"
ActiveDocument.SaveAs FileName:=tb - 1 & "Table(s)Of_" & a & ".doc"
MsgBox "表格文档保存完毕(c:)。" , vbInformation , "保存"
Else:
MsgBox "该文档中无表格。"
End If
End If
End Sub
PPT学习论坛
回复

使用道具 举报

14

主题

223

帖子

35

幻币

一流武者

Rank: 3Rank: 3

积分
265
QQ
2016-4-12 13:17:32 显示全部楼层
做得确实不错,但也无须到处发贴呀。谢谢合作!
PPT学习论坛
回复 支持 反对

使用道具 举报

11

主题

174

帖子

26

幻币

一流武者

Rank: 3Rank: 3

积分
206
QQ
2016-4-12 14:42:44 显示全部楼层
不好意思,发错地方了。
PPT学习论坛
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册