WordのVBAについて

文章中とテキストボックス内の文字に対して、特定の言語の検索と検索結果に該当する文字にマーカーを引くVBAを作成したいのですが詳しい方ご協力お願いできませんでしょうか。
文章中のみに検索しマーカーを引くのは、ネット検索でいくつかあったのですが、テキストボックス内を含めてできるものがなく・・・。
私自身VBAに詳しくなくお教えいただきたいです。

質問者からの補足コメント

• 現状使用可能な文章中にマーカーを引くマクロがこちらです。
  (エク短様http://extan.jp/?p=5569のVBAを参考にしています。)
  Sub 複数の文字列を検索しハイライト表示する()
  Dim csvFilePass
  Dim strBuf As String
  Dim tmp As Variant
  　csvFilePass = "\\～～～～～～～～～～～～～～"
  　Open csvFilePass For Input As #1
  　　Do Until EOF(1)
  Line Input #1, strBuf
  tmp = Split(strBuf, ",")
  Options.DefaultHighlightColorIndex = wdPink '蛍光ペン色：ピンク
  （次補足に続きます。）

    補足日時：2023/01/11 15:54

• With Selection.Find
  　　【各種検索条件設定は文字数過多のため省略。】
  　 End With
  Selection.Find.Execute Replace:=wdReplaceAll
  　Loop
  Close #1
  MsgBox "完了しました。"
  End Sub
  
  以上です。

    補足日時：2023/01/11 15:55

No.3 ベストアンサー 回答者： Qchan1962 回答日時： 2023/01/11 19:35

＞私自身VBAに詳しくなくお教えいただきたいです。

読み落としました　
＃２に書いた内容でアレンジは判り難かったかも・・With .Find　変だし・

参考にされているコードを見ながら　サンプルを書いて見ました
メソッド・プロパティ、Findのリセットなど・・調べてみてください

Sub Example()
Dim csvFilePath As String
Dim strBuf As String
Dim tmp() As Variant
Dim n As Integer
Dim strKey As Variant

csvFilePath = "C:\Users\・・・・・\検索リスト.csv"
'検索キーの配列を作る
Open csvFilePath For Input As #1
Do Until EOF(1)
Line Input #1, strBuf
ReDim Preserve tmp(n)
tmp(n) = Split(strBuf, ",")(0)
n = n + 1
Loop
Close #1

Options.DefaultHighlightColorIndex = wdPink
'文章　検索・置換の設定をおこないます。
For Each strKey In tmp
With Selection.Find
.Format = True
.ClearFormatting
.Replacement.ClearFormatting
.Replacement.Highlight = True
.Text = strKey '検索ワードを代入します。
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.MatchCase = True
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchFuzzy = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Next

'TextBoxを対象に処理
Dim shp As Shape
For Each shp In ActiveDocument.Shapes
If shp.Type = msoTextBox Then
Call setHighlight(shp, tmp)
End If
Next

End Sub

Public Sub setHighlight(shp As Shape, tmp As Variant)
Dim strKey As Variant
With shp.TextFrame.TextRange.Find
For Each strKey In tmp '複数キーでループ
.Text = strKey
.Replacement.Highlight = wdPink
.Execute Replace:=wdReplaceAll
Next
End With
End Sub

この回答へのお礼

ご丁寧にありがとうございました。
こちらを使って無事に機能しました！！
大変助かりました。

お礼日時：2023/01/18 16:11

No.5 回答者： enunokokoro 回答日時： 2023/01/12 09:04

特定の言語が何語なのかわかりませんが。

例えば、Wordがステータスバーで[韓国語]と認識している文字を
対象にする場合なら、以下のマクロで可能です。
（言語指定のみなので、他ファイルを参照するようなものは不要）

' ********************* ここから ***********************
Dim strFind As String
Dim strReplace As String

Sub 言語指定で蛍光ペン()
'
' 本文とテキストボックスを対象にする場合
'

' テキストボックス用変数
Dim sp As Shape
' 置換対象のための変数
Dim rng As Range

' 検索する文字列
　strFind = ""
' 置換後の文字列
　strReplace = ""

' 本文領域の場合、置換する場所の変数は不要
　Set rng = ActiveDocument.Range(Start:=0, End:=0)
' 置換するための設定
　Call myFind(rng)

' テキストボックスの場合
　For Each sp In ActiveDocument.Shapes
　　If sp.Type = msoTextBox Then
　　　Set rng = sp.TextFrame.TextRange
　　　Call myFind(rng)
　　End If
　Next
' メッセージボックスが必要なら
　MsgBox "完了しました。"
End Sub

Public Function myFind(rng As Range)
　With rng.Find
　　.LanguageID = wdKorean
　　.Text = strFind
　End With
　With rng
　　Do While .Find.Execute = True
　　　rng.HighlightColorIndex = wdPink
　　Loop
　End With
End Function
' ********************* ここまで ***********************

No.4 回答者： Qchan1962 回答日時： 2023/01/12 01:27

＃３のコードを見直しました

動くとは思うのですが・・
For Each strKey In tmp
With Selection.Find
の部分が気になっています

参考サイトのキーワードループが腑に落ちず(私的に）
tmp(n) = Split(strBuf, ",")(0)
として　（CSV抽出ループ内で処理を繰り返さない為）
先に検索キーワードを配列に入れCSVを閉じ使う事にしたのに

配列を使用する時に同じことを行ってしまいましたので
どちらでも良いかもですが確認訂正してください・・

文章部分の処理
'文章　検索・置換の設定をおこないます。
With Selection.Find
For Each strKey In tmp
.Format = True
.ClearFormatting
.Replacement.ClearFormatting
.Replacement.Highlight = True
.Text = strKey '検索ワードを代入します。
.Forward = True
.Wrap = wdFindContinue
.MatchCase = True
.Execute Replace:=wdReplaceAll
Next
End With
デフォルトパラメータは削除してしまいましたが
問題が生じる場合は加えてください

No.2 回答者： Qchan1962 回答日時： 2023/01/11 17:32

＞テキストボックス内の文字に対して、特定の言語の検索と検索結果に該当する文字にマーカーを引くVBA

文章中・・・はすでにあり理解されているものと存じますので
テキストボックス内の文字列　を対象にするサンプルです

一例ではActiveDocument.Shapes(1)　が　対象のテキストボックスとして
最低限の実行コードですので
ActiveDocument.Shapes(i)　に対して　.Type = msoTextBox　などで分岐するか、オブジェクト名を明示して実行して下さい
また、複数文字列や複数Highlightの場合　引数付きのSubルーチンにした方が良いかも知れませんね

Public Sub Sample()
Options.DefaultHighlightColorIndex = wdPink
With ActiveDocument.Shapes(1) 'Shapeオブジェクト指定（TextBox仮定）
With .TextFrame.TextRange
With .Find
.Text = "対象文字"
.Replacement.Highlight = wdPink
.Execute Replace:=wdReplaceAll
End With
End With
End With
End Sub

No.1 回答者： めぐみん_ 回答日時： 2023/01/11 15:24

Wordの利用は経験皆無ですが、VBA以前に手作業では出来るものなのでしょうか？

可能ならマクロの記録を取って見ると回答者のヒントになるかもですよ。

この回答へのお礼

コメントありがとうございます。
マクロの記録を使ったことがなくうまくとってこれなかったので、
現状使用できているVBAを補足説明で追記しました。
ご助言ありがとうございます。

お礼日時：2023/01/11 15:59