先日、「【Wordマクロ】図番号を検索する
」の記事を書きました。
よくよく考えたら、要望されていたマクロはこれではないな、と先ほど気づきました。
まだご本人からクレームはきておりませんが(笑)。
たしか、特定の図を探す処理をご要望されていたように思います。
▼このマクロでできること
指定した図番号にカーソルを移動させます。
文字列が選択されていない場合にマクロを実行すると、番号の入力ダイアログボックスが表示されます。入力した番号の図番号を検索します。
文字列が選択されている場合には、その文字列を検索します。
図番号を検索した場合、図に関する説明が周囲に記載されているとは限らないので、同じ図番号で別の個所の記載を確認したい(別の個所の記載へカーソルを移動させたい)と思うのではないでしょうか。
そのため、図番号が選択された状態でマクロを実行すれば、その図番号を検索するような仕組みにしました。
▼マクロの解説
図の番号の入力のダイアログボックスにて、数字以外の文字列を入力した場合には、再度入力を催促する仕組みになっています。
Do ... Loop While IsNumeric(FigNum) = False
IsNumeric 関数を利用して判定しています。
図の番号は、半角数字か全角数字で記載されているため、検索条件で「半角・全角の区別」をオフにしています。
▼マクロ1
Sub 指定した図番号を検索_次()
Dim myRange As Range
Dim FigNum As String
Dim myText As String
If Selection.Type = wdSelectionIP Then
'番号の入力
Do
FigNum = InputBox("番号を入力してください", "図番号を入力")
If FigNum = vbNullString Then Exit Sub
Loop While IsNumeric(FigNum) = False
myText = "図" & FigNum
Else
myText = Selection.Text
End If
Set myRange = Selection.Range
With myRange.Find
.Text = myText
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False '大文字と小文字の区別する
.MatchWholeWord = False '完全に一致する単語だけを検索する
.MatchAllWordForms = False '英単語の異なる活用形を検索する
.MatchSoundsLike = False 'あいまい検索(英)
.MatchFuzzy = False 'あいまい検索(日)
.MatchByte = False '半角と全角を区別する
.MatchWildcards = False 'ワイルドカードを使用する
If .Execute = True Then
myRange.Select
Else
MsgBox myText & "が見つかりませんでした。"
End If
End With
Set myRange = Nothing
End Sub
▼マクロ2
Sub 指定した図番号を検索_前()
Dim myRange As Range
Dim FigNum As String
Dim myText As String
If Selection.Type = wdSelectionIP Then
'番号の入力
Do
FigNum = InputBox("番号を入力してください", "図番号を入力")
If FigNum = vbNullString Then Exit Sub
Loop While IsNumeric(FigNum) = False
myText = "図" & FigNum
Else
myText = Selection.Text
End If
Set myRange = Selection.Range
With myRange.Find
.Text = myText
.Forward = False
.Wrap = wdFindAsk
.Format = False
.MatchCase = False '大文字と小文字の区別する
.MatchWholeWord = False '完全に一致する単語だけを検索する
.MatchAllWordForms = False '英単語の異なる活用形を検索する
.MatchSoundsLike = False 'あいまい検索(英)
.MatchFuzzy = False 'あいまい検索(日)
.MatchByte = False '半角と全角を区別する
.MatchWildcards = False 'ワイルドカードを使用する
If .Execute = True Then
myRange.Select
Else
MsgBox myText & "が見つかりませんでした。"
End If
End With
Set myRange = Nothing
End Sub
▼関連記事
【Wordマクロ】図番号を検索する