Microsoft Word VBA Words Checker(freeware) Download: http://cbalab.com/public/translation_tools/wordlist_checker.docm
翻訳や校正作業に役立つツールです。公開前に「リストにある用語一覧がワード文書に含まれていないか」を一括チェックできます。Microsoft のワードVBAで書いてありますので、必要な修正を加えて使用することも可能です。社内でチェックする必要がある用語一覧などがある場合には、このワード文書にそのリストを入れて「Start」ボタンを押すだけで一括検索がはじまり、その結果をレポート文書にしてくれます。
CBA（コミュニケーションビジネスアヴェニュー）では、Office文書の作業効率を上げる各種ソリューションを提供しています。製品がいちばん良い場合もありますし、お話を聞いてプログラムを作ったほうが良ければ、弊社のエンジニアリングチームで作ってしまうこともあります。これまでに、エクセルの画像を前処理したり、音声をテキスト化してRPAに入れたり、OCRを組み合わせたり、「RPAと独自ミニプログラムを組み合わせた解決」をはかったプロジェクトも多く経験しています。どうぞお気軽に、お問合せフォームからお尋ねください。
マクロの入った文書をダウンロードして使用できないポリシーなどがある拠点の方のために、マクロをこちらにも公開します。
ーWord文書のファイル名を、”wordlist_checker.docm”という名前にしてください。
―ワード文書の中に３列の表を作り、「検索語、コメント、除外フラグ」の列を作ってください。
ーボタンを配置して、ボタンをクリックしたら、「マクロ：YougoCheck()」を呼ぶようにします。
‘
‘ Word Documents Auto Word search
‘ 2018 by CBA
‘
‘Start checking
Sub YougoCheck()
Dim i As Long
MsgBox “This will search all the words in the list and make a report doc.”
‘On Error GoTo ERR_HNDL
Set wd_app = GetObject(Class:=”Word.Application”)
Set myTable = ActiveDocument.Tables(1)
‘making a new document
Dim n As Date
n = Now
Set wd_Report = Application.Documents.Add
wd_Report.Range.InsertAfter “Auto Word Finder ” & Format(n, “yyyy-mm-dd hh:mm:ss”) & vbCr
wd_Report.Range.InsertAfter “Results:” & vbCr
For i = 1 To wd_app.Documents.Count
‘MsgBox wd_app.Documents(i).Name
If wd_app.Documents(i).Name <> “wordlist_checker.docm” And wd_app.Documents(i) <> wd_Report Then
Dim res As Integer
res = MsgBox(“Would you like to check [” + wd_app.Documents(i).Name + “]?”, vbYesNo + vbQuestion, “Found a Word document.”)
If res = vbYes Then
Call CheckDoc(wd_app.Documents(i), myTable, wd_Report)
End If
End If
Next i
GoTo END_TASK
ERR_HNDL:
MsgBox “couldn’t find the Word file.”
END_TASK:
MsgBox “Search process finished. Check the report.”
wd_Report.Activate
Set wd_app = Nothing
End Sub
‘Checking a Word document
Sub CheckDoc(ByVal doc As Document, ByVal table As Object, ByVal wd_Report As Document)
‘MsgBox “Checking: “doc.Name
‘read the chart
Dim c As Word.Cell
For Each c In table.Columns(1).Cells
Dim keyword As String
Dim Commnent As String
Dim ExcludeFlag As String
Comment = DeleteWhiteSpace(table.Columns(2).Cells(c.RowIndex).Range.Text)
ExcludeFlag = DeleteWhiteSpace(table.Columns(3).Cells(c.RowIndex).Range.Text)
keyword = DeleteWhiteSpace(c.Range.Text)
If Len(keyword) > 0 And keyword <> “Items” And Len(ExcludeFlag) = 0 Then
‘MsgBox (“Search: [” + keyword + “](” + Comment + “)”)
Call SearchDoc(doc, keyword, Comment, wd_Report)
End If
Next
‘MsgBox “Search finished.”
End Sub
‘Search with the provided keyword and display results and comments
Sub SearchDoc(ByVal doc As Document, ByVal keyword As String, ByVal Comment As String, ByVal wd_Report As Document)
‘MsgBox (keyword + “|” + Comment)
‘Select whole story
doc.Activate
doc.Range(0, 0).Select
Dim myRange As Range
Set myRange = doc.Range
myRange.Find.Text = keyword
‘myRange.Find.MatchFuzzy = True
myRange.Find.MatchWildcards = True
myRange.Find.Forward = True
myRange.Find.Wrap = wdFindStop
Do While myRange.Find.Execute
myRange.Select
Dim LineNum As Integer
Dim PageNum As Integer
LineNum = Selection.Information(wdFirstCharacterLineNumber)
PageNum = Selection.Information(wdActiveEndAdjustedPageNumber)
‘MsgBox (“Found: [” & Comment & “] Page:” & PageNum & ” Line:” & LineNum)
wd_Report.Activate
wd_Report.ActiveWindow.Selection.EndKey Unit:=wdStory
Dim line As String
line = “[” & doc.Name & “]” & vbTab & “Page: ” & PageNum & ” Line: ” & LineNum & vbTab & myRange.Text & vbTab & “(” & Comment & “)”
wd_Report.Range.InsertAfter line & vbCr
‘Important!
‘otherwise, this macro will go infinite loop
doc.Activate
myRange.Start = myRange.End
Loop
End Sub
‘Cleaning the line
Function DeleteWhiteSpace(ByVal str As String) As String
str = Replace(str, Chr(7), “”)
str = Replace(str, Chr(11), “”) ‘Soft return
str = Replace(str, vbCrLf, “”)
str = Replace(str, vbCr, “”)
str = Replace(str, vbCrLf, “”)
str = Trim(str)
DeleteWhiteSpace = str
End Function
