Attribute VB_Name = "M" Sub GlobalTrim_2() '空白文字(ホワイトスペース)を、メニューに従って削除する。(MS-Word用) 'VBエディタからMicrosoft VBScript Regular Expressions 5.5への参照を設定しておく。 '(Taiju, 2007.10.9、メニュー7追加 10.11) With Selection iSelectedMenu = LCase(InputBox("  1 空白文字" & vbCr _ & "   (全角・半角Space+TAB)" & vbCr _ & "  2 空白文字(全角Space以外)" & vbCr _ & "  3 改行" & vbCr _ & "  4 行頭の空白(LTrim+TAB)" & vbCr _ & "  5 行末の空白(RTrim+TAB)" & vbCr _ & "  6 行頭・行末の空白(Trim+TAB)" & vbCr _ & "  7 文字列中の空白文字" & vbCr & "   (行頭・行末を除く)", "削除対象")) If iSelectedMenu = 1 Or iSelectedMenu = 3 Then If iSelectedMenu = 1 Then sSearchPtn = "[\t   ]" ElseIf iSelectedMenu = 3 Then sSearchPtn = "\r" End If sReplaceStr = "" sTS = .Text .Text = RegExp_Replace(sTS, sSearchPtn, sReplaceStr) ElseIf iSelectedMenu = 2 Or iSelectedMenu = 4 Or iSelectedMenu = 5 Or iSelectedMenu = 6 Then aryStr = Split(.Text, Chr(10)) MsgBox (aryStr(i)) For i = 0 To UBound(aryStr) If iSelectedMenu = 2 Then sSearchPtn = "[\t ]" sReplaceStr = "" sTS = aryStr(i) ElseIf iSelectedMenu = 4 Then sSearchPtn = "(\r)[\t  ]+" sReplaceStr = "$1" & "" sTS = aryStr(i) ElseIf iSelectedMenu = 5 Then sSearchPtn = "[\t  ]+(\r)" sReplaceStr = "" & "$1" sTS = aryStr(i) ElseIf iSelectedMenu = 6 Then sSearchPtn = "(\r)[\t  ]+|[\t  ]+(\r)" sReplaceStr = "" & "$1" & vbCr sTS = aryStr(i) End If sConStr = sConStr & RegExp_Replace(sTS, sSearchPtn, sReplaceStr) & vbCr Next .Text = sConStr ElseIf iSelectedMenu = 7 Then aryStr = Split(.Text, vbCr) For i = 0 To UBound(aryStr) - 1 Dim sBodyStr As String sSearchPtn = "(([^\t  ]+[\t  ]*)+[^\t  ]+)" sTS = aryStr(i) sBodyStr = RegExp_Find(sTS, sSearchPtn) sReplaceStr = RegExp_Replace(sBodyStr, "[\t  ]", "") sTS = RegExp_Replace(sTS, sBodyStr, sReplaceStr) sConStr = sConStr & sTS & vbCrLf Next .Text = sConStr End If End With End Sub Function RegExp_Find(sTS, sSearchPtn) Dim objRegExp As RegExp Set objRegExp = New RegExp With objRegExp .Pattern = sSearchPtn .Global = True End With Set re = objRegExp.Execute(sTS) If re.Count <> 0 Then RegExp_Find = re.Item(0) End If Set re = Nothing End Function Function RegExp_Replace(sTS, sSearchPtn, sReplaceStr) Dim objRegExp As RegExp Set objRegExp = New RegExp With objRegExp .Pattern = sSearchPtn .IgnoreCase = True .Global = True End With RegExp_Replace = objRegExp.Replace(sTS, sReplaceStr) End Function