概要 |
Unicode(UTF-16 Big Endian)のTAB区切り用語リスト(置換リスト)をリストの上から順に読み込み、開いてるWord文書に一括置換を行うマクロ。中国語・日本語の置換も可能。 |
使用方法 |
マクロを実行すると、読み込む用語リストファイルの選択を促すダイアログが開かれるので目的の用語リストファイルをダブルクリック。 |
作成日 |
2014/09/24 |
更新日 |
2018/03/06 |
作成者 |
糸目 慈樹 |
[Source Code]
Dim Stopper As Boolean
Dim FSO As Object
Dim TrmLis As String
Sub KajiCN01_Replacer_Main()
Dim TextFile As Object ' Variable for text object
Dim buf As String ' for text stream
Dim str As Variant ' array for split text
Dim LC As Long ' for line count of term list file.
Dim i As Long ' Counter
'Prompt User to select term list file, and get the file path.
TrmLis = FilePath("Select Term List File", "Text File", "*.txt")
If TrmLis = "" Then Exit Sub
Set FSO = CreateObject("Scripting.FileSystemObject")
Set TextFile = FSO.OpenTextFile(TrmLis, 1, 0, -1)
LC = ListLine_Count(TrmLis) ' retrieves line count of selected term list file
i = 1 ' initializing the counter
Application.ScreenUpdating = False
With ActiveDocument.Range.Find
.ClearAllFuzzyOptions
.ClearFormatting
.Replacement.ClearFormatting
.MatchWildcards = False
End With
Do Until TextFile.AtEndOfStream
buf = TextFile.ReadLine
str = Split(buf, vbTab)
' Actual replacement takes place here.
On Error GoTo Label1
With ActiveDocument.Range.Find
.Text = str(0)
With .Replacement
.Text = str(1)
End With
.Replacement.Highlight = True
.Wrap = wdFindContinue
.MatchWildcards = True
.Execute
' Execute Replacement only when the string is found for the sake of saving memory
If .Found = True Then
.Execute Replace:=wdReplaceAll
End If
End With
Label1:
i = i + 1
Loop
' Release Text、FSO
Set TextFile = Nothing
Set FSO = Nothing
End Sub
Sub KajiCN02_ClearHighlight()
Selection.WholeStory
Selection.Range.HighlightColorIndex = wdAuto
Selection.Collapse (wdCollapseStart)
End Sub
Function ListLine_Count(ByRef Path As String) As Long
'Retrieves Line count
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
With FSO.OpenTextFile(Path, 8)
ListLine_Count = .Line
.Close
End With
Set FSO = Nothing
End Function
Public Function FilePath(ByRef DlgTitle As String, ByRef fileType As String, ByRef Attr As String) As String
Dim Dlg As FileDialog
Set Dlg = Application.FileDialog(msoFileDialogOpen)
With Dlg
.Title = DlgTitle
.AllowMultiSelect = False
.InitialFileName = Application.Parent
.Filters.Clear
.Filters.Add fileType, Attr
If .Show = 0 Then
MsgBox "Cancelled"
FilePath = ""
Else
FilePath = .SelectedItems(1)
End If
End With
Set Dlg = Nothing
End Function