| |
ryuさんの作ったマクロは、おそらく次のようなものではないかと思われます。
Sub myFontNameCheck()
Dim myCharacter As Range
'
Debug.Print Time
Selection.HomeKey unit:=wdStory
For Each myCharacter In ActiveDocument.Characters
If myCharacter.Font.Name <> "ＭＳ 明朝" _
And myCharacter.Font.Name <> "ＭＳ ゴシック" Then
myCharacter.HighlightColorIndex = wdYellow ' 蛍光ペン書式
End If
Next myCharacter
Debug.Print Time
MsgBox "処理が終了しました。"
End Sub
2ページ半ほどの文書で、このマクロを実行すると、
私のボロ糞マシンで、処理時間は47〜48秒でした。
因みに「Application.ScreenUpdating = False/True」を上のマクロに追加し、
処理中に画面の更新をしない場合、43〜45秒でした。
私の貧弱な頭で考えたところ、
次の2点を試してみました。
しかし、下の件は だれでも考え付くことですので、
ryuさんは既に試しているかも知れません。
１．GoToステートメントで繰り返し処理をする。
（但し、終了条件の都合で、文書の末尾からチェックします。）
２．処理中は画面更新をしない。
（「Application.ScreenUpdating = False/True」を追加。
但し、処理が進んでいるのかどうか判らない。
スクロールバーは動くようですが・・・）
処理時間は27〜28秒でした。
劇的な効果があるとは、言えないようです。
何100ページもある文書なら、その差は大きいかも知れませんが・・・
Sub myFontNameCheck2()
Dim myCount As Long
'
Debug.Print Time
Application.ScreenUpdating = False
Selection.EndKey unit:=wdStory
myCount = Selection.MoveLeft(wdCharacter, 1, wdExtend)
myFontNameCheck2SubEntry:
If myCount = 0 Then
GoTo myFontNameCheck2SubExit
End If
'
If Selection.Font.Name <> "ＭＳ 明朝" _
And Selection.Font.Name <> "ＭＳ ゴシック" Then
Selection.Range.HighlightColorIndex = wdYellow
End If
Selection.Collapse wdCollapseStart
myCount = Selection.MoveLeft(wdCharacter, 1, wdExtend)
GoTo myFontNameCheck2SubEntry
myFontNameCheck2SubExit:
Application.ScreenUpdating = True
Debug.Print Time
MsgBox "処理が終了しました。"
End Sub
|
|
H. C. Shinopy
- 04/7/28(水) 22:27 -
