前回のマクロ
[EXCEL VBA]正規表現を用いて、アクティブシートのテキストボックスの数字をすべてコンマ付きに変えるマクロ
Word VBA 数字をコンマ付き数字に変えるマクロというのを作りましたが、これはテキストボックスは変更できません。
しかし[EXCEL VBA]正規表現を用いて、アクティブシートのテキストボックスの数字をすべてコンマ付きに変えるマクロを少し変えると、ワードの場合、アクティブドキュメントのすべてのテキストボックスの数字をコンマ付きに変えられることがわかりました。
注意点
- [EXCEL VBA]正規表現を用いて、アクティブシートのテキストボックスの数字をすべてコンマ付きに変えるマクロはアクティブシートのみですが、これは全てのテキストボックスが対象です。
- このマクロはテキストボックスのみを変換します。
- 行に数字がまたがった場合うまくいかない可能性があります。
- Word VBA 数字をコンマ付き数字に変えるマクロとは違い、法律や年号に対する例外を設けていません。4桁の数字をみたら変換します。
Sub addCommaWdTxtBox()
'For Word
'VBScript Regular Expression 5.5 Reference Setting
'ActiveSheetのすべてのテキストボックスの数字をコンマ付きに変換する
'小数点があっても区別する
Dim wDoc As Word.Document: Set wDoc = ThisDocument
Dim shp As Word.Shape
Dim REG As RegExp: Set REG = New RegExp
Dim buf As String, buf1 As String, buf2 As String
Dim tF As Word.TextFrame, i As Long, ileng As Long
Dim M As Match, Ms, sMs As SubMatches, m2 As Match
If wDoc.Shapes.Count = 0 Then Exit Sub
For Each shp In wDoc.Shapes
If shp.Type = msoTextBox Then
shp.Select 'テキストボックスを選択する
Set tF = shp.TextFrame 'WordはTextFrameになる
buf = tF.TextRange.Text '文字箱(テキストボックス)の文字をいったん全部読み込む
With REG
Debug.Print buf
.Global = True
.MultiLine = True
.Pattern = "([^0-9][0-9]+\b|[0-9]+\b|[^0-9][0-9]+\.\d{1,}\b| [0-9]+\.\d{1,}\b)"
'([^0-9][0-9]+\b 数字以外と数字の連続で任意の単語境界
'[0-9]+\b数字の連続で任意の単語境界
'[^0-9][0-9]+\.\d{1,}\b数字以外と数字の連続(小数点を含む)で任意の単語境界
'[0-9]+\.\d{1,}\b 数字と小数点、その下に1つ以上の数字の連続のあとに任意の単語境界
Set Ms = .Execute(buf): Debug.Print Ms.Count '検索して適合集合の作成
For i = 0 To Ms.Count - 1 'ポイント:マッチ順に変換するため文頭からカウントする
Set M = Ms.Item(i)
'小数点が頭にある場合はこんまがいらないのでカットする
If Left(M.Value, 1) <> "." Then
'まいなすではないとき
If Left(M.Value, 1) <> "-" Then
buf1 = M.Value
If CheckIsNumber(buf1) = True Then
'1文字目が数字ならそのまま1回だけ変換する
buf = Replace(buf, M.Value, Format(buf1, "#,##0"), 1, 1, vbTextCompare) '内部演算は15桁しかないが、それ以上でも変換できる
Else
'1文字目が数字でないなら2文字目からFormatで変換し、1文字目の数字以外のものを付ける
buf1 = Mid(M.Value, 2, M.Length)
buf = Replace(buf, M.Value, Mid(M.Value, 1, 1) & Format(buf1, "#,##0"), 1, 1, vbTextCompare)
End If
Else
'まいなすのとき
buf1 = Mid(M.Value, 2, M.Length)
buf = Replace(buf, M.Value, Left(M.Value, 1) & Format(buf1, "#,##0"), 1, 1, vbTextCompare)
End If
End If
Next i
tF.TextRange.Text = ""
tF.TextRange.Text = buf '変換後の文字列をいれる
Exit Sub
End With
End If
Next
End Sub
Function CheckIsNumber(str As String) As Boolean
'最初の文字が数字か否かを確認する関数
'文字列として数字が入る
Dim ile As Long
Dim Rex As RegExp: Set Rex = New RegExp
On Error Resume Next
'型変換をしてエラーが出るかを確認する
ile = Mid(CStr(str), 1, 1)
If Err.Number <> 0 Then
'エラーが発生したら数字ではない
CheckIsNumber = False: Exit Function
Else
'長整数型に変換できれば数字
CheckIsNumber = True: Exit Function
End If
End Function