「ホントのフォント」使用中の書式を瞬時に判定 で紹介した処理で使われているマクロを紹介します。
「ホントのフォント」では、ユーザーフォームを用いてダイアログボックスを表示させていますが、以下のマクロでは、メッセージボックスを使っています。
そういう意味で完全に同じものではありませんが、処理の考え方は一緒です。
<目次>
このマクロでできること
下付き
上付き
太字
斜体
下線(一重線)
取消線
蛍光ペン
の書式を文書中から探し、使われている書式をメッセージボックスで表示します。
マクロの解説
7種類の書式を使っていますので、7つを場合分けをして処理をしています。
このような場合の場合分けには、Select Caseステートメントが便利です。
かつて書いたブログ では、If と ElseIf を組み合わせる方法を紹介しましたが、少しわかりにくいですね。
マクロ
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 myStyle(1) = "下付き" myStyle(2) = "上付き" myStyle(3) = "太字" myStyle(4) = "斜体" myStyle(5) = "下線(一重線)" myStyle(6) = "取り消し線" myStyle(7) = "蛍光ペン" For i = 1 To 7 Set myRange = ActiveDocument.Range(0, 0) With myRange.Find .Text = "" .Forward = True Select Case i Case 1 .Font.Subscript = True Case 2 .Font.Superscript = True Case 3 .Font.Bold = True Case 4 .Font.Italic = True Case 5 .Font.Underline = wdUnderlineSingle Case 6 .Font.StrikeThrough = True Case 7 .Highlight = True End Select .Wrap = wdFindStop .Execute If .Found = True Then myStyleFound = myStyleFound & vbCr _ & myStyle(i) End If End With Next Set myRange = Nothing If Len(myStyleFound) <> 0 Then MsgBox "現在の文書で使用されている書式" & vbCr _ & myStyleFound, vbInformation, "検索結果" Else MsgBox "見つかりませんでした。", _ vbExclamation, "検索結果" End If End Sub