VBA操作word
标记数字
要求：将word 文档中的所有数字标记出来
Sub 修改word的所有数字()
t = Timer()
Dim i As Long, c As Range, d As Document
'遍历该段落中全部字符
For i = 1 To Application.ActiveDocument.Characters.Count
'将第i个字符构成的range对象赋给c
Set c = Application.ActiveDocument.Characters(i)
If IsNumeric(c.Text) Then
'range.value在word中为range.text
c.Bold = True
c.Font.ColorIndex = wdRed
c.Italic = True
End If
Next i
MsgBox "一共用了" & Timer() - t & "秒"
End Sub
注意事项：第一是要写在word中间而不是excel里面
第二是要启用docm而不是docx
上述代码工作效率较低，一页文档几百个字符用了4分钟才处理完，具体技术优化暂时还做不到，留个坑以后填
在word中的数组都是一维的，没有行和列这种概念
range(3,8)从第3号字符开始，到第8号字符之前结束，从0开始编号
得到34567这5个字符
运用正则表达式
找出所有百分数
如果把上述正则表达式改为"\d"，按理上也是找到所有的数字，效率会高很多，一秒都不需要
不过我只在整个论文的摘要页使用，没有问题，但是推广到全文，就有很多意想不到的错误
我直接用上述代码推广到全文，也出现了一些意想不到的错误，但是我单独把段落复制到正则表达式检测器里面，又发现表达式没有问题，所以这里继续留坑
Sub 修改word的所有数字3()
t = Timer()
Dim s As Range, d As Document
Dim reg As Object, mches As Object, mch As Object
Set d = Application.ActiveDocument
'd代表当前活动文档
Set reg = CreateObject("vbscript.regexp")
'创建正则表达式对象
reg.Pattern = "\d"
'数字
reg.Global = True
'调用reg
Set mches = reg.Execute(d.Range.Text)
'执行语句
For Each mch In mches
Set c = d.Range(mch.firstindex, mch.firstindex + mch.Length)
c.Font.ColorIndex = wdRed
Next mch
'扫描
MsgBox "一共用了" & Timer() - t & "秒"
End Sub
每段生成新的文件
Sub 批量处理段落()
Dim t
t = Timer()
Dim i As Long, p As Paragraph
Dim d1 As Document, d2 As Document
Set d1 = ActiveDocument
i = 1
For Each p In d1.Paragraphs
'扫描d1中的每一段
Set d2 = Application.Documents.Add
'新建word文档
d2.Range.Text = d1.Paragraphs(i).Range.Text
'将刚读出的一段写入d2
d2.SaveAs "G:\网课\杨洋VBA\全民一起VBA提高篇(Excel数据处理)\生成段落\" & i & ".docx"
'另存为新文档
d2.Close
i = i + 1
Next p
MsgBox "一共用了" & Timer() - t & "秒"
End Sub
设置页眉
实际中应该用不着，因为这里不太方便设置各种样式和杂七杂八的格式，这里只是说明操作上的可能性
Sub 批量设置页眉()
Dim t
t = Timer()
Dim i As Long, d As Document
For i = 1 To 16
Set d = Application.Documents.Open("G:\网课\杨洋VBA\全民一起VBA提高篇(Excel数据处理)\生成段落\" & i & ".docx")
'打开操作
d.Sections(1).Headers(1).Range.Text = "锦到黑"
'对象的属性，需要的时候稍微查阅就能懂
d.Save
'保存和关闭操作
d.Close
Next i
MsgBox "一共用了" & Timer() - t & "秒"
End Sub
因为涉及打开和关闭，所以运行速度并不快，一次循环大概就要2秒，16个文件跑了31秒
如果文件量太大，仍然很耗时间
可以选择通过在EXCEL里面运行程序，有利于提高工作效率，这次花了25秒
Sub 批量设置页眉()
Dim t
t = Timer()
Dim i As Long, d As Object, doc As Object
Set d = CreateObject("word.application")
'在excel 的vbe中间引入word
For i = 1 To 16
Set doc = d.Documents.Open("G:\网课\杨洋VBA\全民一起VBA提高篇(Excel数据处理)\生成段落\" & i & ".docx")
'将doc对象指向打开操作
doc.Sections(1).Headers(1).Range.Text = "锦到热"
doc.Save
'保存和关闭操作
doc.Close
Next i
MsgBox "一共用了" & Timer() - t & "秒"
End Sub
还可以用大杀器getobject
Sub 批量设置页眉()
Dim t
t = Timer()
Dim i As Long, doc As Object
For i = 1 To 16
Set doc = GetObject("G:\网课\杨洋VBA\全民一起VBA提高篇(Excel数据处理)\生成段落\" & i & ".docx")
'将doc对象指向打开操作
doc.Sections(1).Headers(1).Range.Text = "锦到说嘛"
'set doc=getobject()
'相当于set doc =workbooks.open
doc.Save
'保存和关闭操作
doc.Close
Next i
MsgBox "一共用了" & Timer() - t & "秒"
End Sub
非常关键的一点，这种做法不会在屏幕上显示打开和关闭，一个是干净，二个是效率提高
但是一定得对应文件对应软件来跑，代码相同
同样的对word进行处理，在EXCEL跑这一段，27秒
在word里面14秒，术业有专攻
