[求助]如何解决这样的字体替换?

xlf512

各位高手:请教了. 有一些文档,文档中的字体格式不统一,按领导要求要将字体统一． 要求如下: 有关宋体的如:"宋体","方正报宋_GBK","方正粗宋_GBK","华文中宋","方正宋三_GBK"等还有一些,我没有全部列出,也就是字体名中含有一个"宋"字的,全部替换成"华文仿宋"这种字体. 请问这如何实现(用VBA)?

十年磨一剑

Sub 段落来替换()
'如果你是按段落来设置的可以这样

Dim apar As Paragraph
Application.ScreenUpdating = False
On Error GoTo errhandler

For Each apar In ActiveDocument.Paragraphs
If apar.Range.Font.Name Like "*宋*" Then
apar.Range.Font.Name = "宋体"
End If
Next

errhandler:
Application.ScreenUpdating = True

End Sub
Sub 字符来替换()

'如果是按字符的则在每个charater间循环，但是速度会很慢
Dim apar
Application.ScreenUpdating = False
On Error GoTo errhandler

For Each apar In ActiveDocument.Range.Characters

If apar.Font.Name Like "*宋*" Then

apar.Font.Name = "宋体"
End If
Next

errhandler:
Application.ScreenUpdating = True

End Sub

xlf512

谢谢"十年磨一剑"的解答.

我觉得第一种方法不太好,原因是要整段都要是文字,并且都要是同一字体,如果段落中有一个哪怕是只一个英文或其它的字符,就不行了,apar.Range.Font.Name 显示为空.

而第二种确实速度很慢,文档一长的话,有一点假死的感觉,很不舒服,有没有更好的办法呢.