秀丸マクロ, Word VBA, or the like -46ページ目

秀丸の弱点(特殊文字・記号)

以前、秀丸の弱点という記事で、秀丸に乗り換える際に躊躇する要因をいくつか列挙しましたが、
その中に、特殊文字について書くのを忘れていました。

つまり、αだとかβだとかΔだとか、θだとか・・・

まあ、こういったてのやつです。

全角の特殊文字、μθΔなどは、秀丸でも問題なく表示されます。
が!
半角の特殊文字は、化けてしまったり、自動的に全角の特殊文字に修正されたりします。


エンコーディングでなんとかなるものも有りますが、まあめんどくさいです。

この問題については、以下の二つの解決方法があります。

(1)化けない文字を代用したり、スペルアウトしてしまう方法。

は、centi gradeだとか、degree Celciusとしたり、
μにはuを代用する。



(2)以前の書式の問題と同様に、タグをつけてやる。

例えば、
μは、<@&gtSmallMu</@>とします。

これなら秀丸でも問題なく表示されます。

秀丸での作業が終わって、Wordに戻して仕上げをするときには、逆にタグ付きの文字列を特殊文字に置換します。


この(2)の方法についてなんですが、特殊文字や記号って分野によってはものすごく豊富な種類が出てきたりするので、一つ一つ置換するのも大変。やってられません。

マクロで処理するにしても、置換したい特殊文字が増えるたびにまたマクロのコードをいじるのってすごく面倒です。

ということで、ちょっと工夫します。

用語集を使った一括置換のように、
特殊文字をタグ付きの文字列に置き換えるための、特殊文字一括置換リストを作成しておいて、
そのリストをマクロで読み込んで一括置換します。

つまり、
α[TAB]<@&gtSmallAlpha</@>
β[TAB]<@&gtSmallBeta</@>
μ[TAB]<@&gtSmallMu</@>

という感じのリストを作成しておき、
このリストを読み込んで置換するマクロを作ります。

逆にタグ付きの文字列を半角の特殊文字に置き換えるためのリストも作成しておきます。
こちらは、文字列[TAB]文字列という形ではなくて、
文字列[TAB]対応する半角文字の文字コード
というペアにします。

例えば、
<@&gtSmallAlpha</@>[TAB]945
<@&gtSmallBeta</@>[TAB]946
<@&gtSmallMu</@>[TAB]956

という感じです。

このリストを読み込んで置換を行うマクロは、

置換文字列が<@>....</@>であっても、文字コードであっても1セットの置換コードで、行えるようにします。

こうして作ったのが以下のマクロです。

なお、このマクロに欠かせないChrW(文字コード)については、新田順也氏この記事を参考にさせていただきました。

また、ファイルオープンダイアログの部分についても同氏のブログを参考にさせていただいています。

動作確認は、Word2003と2007で行っていますが、使用は自己責任でお願いします。

Sub 特殊文字の加工()
''実行するのはこのマクロです。
Dim FileName As String
Dim fileNo As Integer
Dim buf
Dim strArray() As String
fileNo = FreeFile
FileName = GetFileName
Open FileName For Input As #fileNo
Application.ScreenUpdating = False

Do Until EOF(fileNo)
Line Input #fileNo, buf
strArray = Split(buf, vbTab)
On Error Resume Next
If strArray(1) <> "" Then
Call SymbolFontProcessing(strArray(0), strArray(1))
End If
Loop
Close #fileNo
Application.ScreenRefresh
End Sub

Private Function GetFileName() As String
Dim strPath As String
Dim dlg As Dialog
Dim dlgFind As Dialog
Dim DefaultPath As String

DefaultPath = Application.Options.DefaultFilePath(wdDocumentsPath)
Application.Options.DefaultFilePath(wdDocumentsPath) = ActiveDocument.Path
Set dlg = Dialogs(wdDialogFileOpen)
Set dlgFind = Dialogs(wdDialogFileFind)

With dlg
.Name = "*.txt"
Select Case .Display
Case -1
dlgFind.Update
strPath = dlgFind.SearchPath
Case Else
End
End Select
End With
Application.Options.DefaultFilePath(wdDocumentsPath) = DefaultPath
GetFileName = strPath & "\" & dlg.Name
End Function

Private Sub SymbolFontProcessing(ByVal Search As String, ByVal RepString As String)
With ActiveDocument.Range.Find
If Val(Search) <> 0 Then
.Text = ChrW(Val(Search))
Else
.Text = Search
End If
With .Replacement
If Val(Search) > 61000 Then .Font.Name = "TimesNewRoman"
If Val(RepString) <> 0 Then
.Text = ChrW(Val(RepString))
Else
.Text = RepString
End If
End With
.Wrap = wdFindContinue
.Execute
If .Found = True Then .Execute Replace:=wdReplaceAll
End With
End Sub


一括置換リストを作成するためには、文字コードを調べる必要が有ります。
そのために、以下のおまけ(1)おまけ(2)のマクロを作成しましたので良かったら使ってください。


おまけ(1)

コードを調べたい文字を1文字だけWordファイルに記入します
(他の文字は一切無しの状態です)。

この状態で、以下のマクロを実行すると、メッセージボックスでコードを表示してくれます。

Sub 半角特殊文字のコード調査()
Dim i As Long

' "For i = (コードの最小値) To (コードの最大値)"
' 最小値は、"Z"(90)の次の91

For i = 91 To 61562

Selection.Find.ClearFormatting
With Selection.Find
.Text = ChrW(i)
.Wrap = wdFindContinue
.Execute
If .Found = True Then
MsgBox i
Exit For
End If
End With
Next i

End Sub



おまけ(2)

実行すると、開始文字コード(始点)と、終了文字コード(終点)とを聞いてきます。

それぞれの文字コードを入力すると、その範囲内の文字を順番に入力してくれます。

さらに、各文字の横に対応する文字コードを入力してくれます。

Sub 指定範囲のコードの文字を入力()
Dim i As Long
Dim First As Long
Dim Last As Long
Dim ans As String

First = InputBox("開始文字コード")
Last = InputBox("終了文字コード")

If First > Last Then
MsgBox "開始コードは、終了コード小さくなければダメです。"
Exit Sub
End If


'範囲がでか過ぎてもなんなんで、この処理を入れておきます。
'500という数値を適宜いじってください。

If Last - First > 500 Then
ans = MsgBox("範囲が広すぎかもしれません。実行しますか?", vbYesNo)
If ans = vbNo Then Exit Sub
End If

For i = First To Last
Selection.TypeText ChrW(i) & vbTab & i & vbCr
Next i

End Sub


マクロの実行方法については、このブログでも以前のこの記事で説明してますので良かったらご参照ください。