使用中の書式を検索するマクロ

文書を作成するときに、いろいろと書式を使いますね。

私は、メモとしていろいろな書式を書き込みますが、納品時にはそれらのメモがないことを確認する必要があります。

そんなときに便利なマクロです。

Sub Style_Check()

      Dim myRange As Range
      Dim myStyle(1 To 7) As String
      Dim i As Integer
      Dim myStyleFound As String
      Dim blnStyle As Boolean

10    myStyle(1) = "下付き"
20    myStyle(2) = "上付き"
30    myStyle(3) = "太字"
40    myStyle(4) = "斜体"
50    myStyle(5) = "下線（一重線）"
60    myStyle(6) = "取り消し線"
70    myStyle(7) = "蛍光ペン"

80    For i = 1 To 7

90        Set myRange = ActiveDocument.Range(0, 0)

100       With myRange.Find
110           .Text = ""
120           .Forward = True
                     
130           If i = 1 Then
140               .Font.Subscript = True
150           ElseIf i = 2 Then
160               .Font.Superscript = True
170           ElseIf i = 3 Then
180               .Font.Bold = True
190           ElseIf i = 4 Then
200               .Font.Italic = True
210           ElseIf i = 5 Then
220               .Font.Underline = wdUnderlineSingle
230           ElseIf i = 6 Then
240               .Font.StrikeThrough = True
250           ElseIf i = 7 Then
260               .Highlight = True
270           End If

280           .Wrap = wdFindStop
290           .Execute
             
300           If .Found = True Then
310               myStyleFound = myStyleFound & vbCr & myStyle(i)
320           End If
             
330       End With

340   Next

350   Set myRange = Nothing

360   If Len(myStyleFound) <> 0 Then
370       MsgBox "現在の文書で使用されている書式" & vbCr & myStyleFound, vbInformation, "検索結果"
380   Else
390       MsgBox "見つかりませんでした。", vbExclamation, "検索結果"
400   End If

End Sub