【Word VBA】摂氏度と華氏度の表記を統一するWordマクロ

2016年11月2日

, ,

Wordで動く翻訳チェックソフト「色deチェック」のユーザーから、温度のチェックができない場合があると連絡をいただきました。

詳しく聞いてみると、なんと、温度表記において、度の○記号に半角アルファベットのオーが使われていました。もちろん、上付き書式で。

あ、それは色deチェックではチェックできません（笑）。

「色deチェック」の次の更新時に対応させます。

今回の記事では、このように度の○に半角アルファベットのオー（大文字・小文字）が使われている場合に、Degree Sign （°）に変換するマクロを紹介します。

このマクロでできること

以下のように上付き表示された半角アルファベットのオーを処理対象にします。

表記ルール上は数字と度の○との間に半角スペースは入らないと思うのですが、実務上は半角スペースが入っていたりします。

なので、半角スペースが挿入されている場合とされていない場合の両方を処理対象にしました。

（実行前）

温度表記

（実行後）

Degree Signに変換された箇所が蛍光ペンで着色されます。

一括処理をする場合には、処理をした箇所がどこなのか確認する必要があると思いますから、蛍光ペンで着色をしておきます。

数字とDegree Signの間の半角スペースはそのまま残しました。

温度表記

マクロの解説

処理対象として検索するパターンを8種類定義しました。（20行目～27行目）

数字の直後に華氏と摂氏の記号がある場合です。

さらに、誤判定を防ぐために、この場合にアルファベットのオーが上付きになっている場合だけ処理を実行しています。（62行目）

マクロ

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
Sub DegreeSignに統一するマクロ()
 
　Dim myRange As Range
　Dim myDoc As Document
　Dim myFind(8) As String
　Dim i As Integer
　Dim Pos_Start As Long
　Dim Pos_End As Long
 
　'-------------------------------------------
　'前処理
　'-------------------------------------------
 
　Set myDoc = ActiveDocument
 
　'-------------------------------------------
　'検索パターンの設定
　'-------------------------------------------
　
　myFind(1) = "[0-9]{1,}oF"
　myFind(2) = "[0-9]{1,}OF"
　myFind(3) = "[0-9]{1,}oC"
　myFind(4) = "[0-9]{1,}OC"
　myFind(5) = "[0-9]{1,} oF"
　myFind(6) = "[0-9]{1,} OF"
　myFind(7) = "[0-9]{1,} oC"
　myFind(8) = "[0-9]{1,} OC"
 
　'-------------------------------------------
　'処理
　'-------------------------------------------
 
　For i = 1 To UBound(myFind)
 
　　'検索開始位置の指定（文書の先頭）
　　Set myRange = myDoc.Range(0, 0)
 
　　With myRange.Find
　　　.Text = myFind(i)
　　　.Forward = True
　　　.Wrap = wdFindStop
　　　.Format = False
　　　.MatchCase = False
　　　.MatchWholeWord = False
　　　.MatchByte = False
　　　.MatchAllWordForms = False
　　　.MatchSoundsLike = False
　　　.MatchFuzzy = False
　　　.MatchWildcards = True
　　　
　　　'対象が見つかる間は検索を実行し続ける
　　　Do While .Execute = True
　　　　
　　　　With myRange
　　　　
　　　　　'myRange範囲の末尾から2文字目の特定
　　　　　Pos_Start = .Start + Len(.Text) - 2
　　　　　Pos_End = Pos_Start + 1
　　　　　.SetRange Start:=Pos_Start, End:=Pos_End
　　　　　
　　　　　'特定した文字列が上付きの場合に書き換え
　　　　　If .Font.Superscript = True Then
　　　　　　'Degree Sign の入力
　　　　　　.Text = "°"
　　　　　　'半角に設定
　　　　　　.CharacterWidth = wdWidthHalfWidth
　　　　　　'上付きの解除
　　　　　　.Font.Superscript = False
　　　　　　'蛍光ペンで着色
　　　　　　.HighlightColorIndex = wdBrightGreen
　　　　　End If
　　　　End With
　　　　
　　　　'選択範囲の解除
　　　　myRange.Collapse wdCollapseEnd
　　　　
　　　Loop
　　　
　　End With
 
　Next
 
　'-------------------------------------------
　'後処理
　'-------------------------------------------
 
　'オブジェクト変数の解放
　Set myDoc = Nothing
　Set myRange = Nothing
 
End Sub

-コード
-, ,

S