Sub EspCfx() Rem *----*----* *----*----* *----*----* *----*----* Rem エスペラント語 代用文字 範囲内置換処理 Rem 作譜:Hitrock Camellia Shinopy Rem 言語:Outlook VBA Rem 機能... Rem 選択した文字列の範囲内にある代用文字を正書文字に置換する。 Rem 注記... Rem 1. 文字列の範囲を指定しない場合は、カーソルより前の1段落を置換の範囲にする。 Rem 2. [x]接尾字のcghjsuCGHJSUをエスペラント正書文字に置換する。 Rem 3. [^]接尾字のcghjsuCGHJSUをエスペラント正書文字に置換する。 Rem 4. [~]接尾字のuUをエスペラント正書文字に置換する。 Rem 5. [_]接尾字のaeiouAEIOUを屈音符付き母音字に置換する。 Rem 6. このマクロは、[メール][予定表][仕事]の[本文]入力で有効。 Rem 履歴... Rem 第01版:2010/05/03:作成。 Rem *----*----* *----*----* *----*----* *----*----* Dim mySelection As Object Dim myCount As Long Dim myChar As Long Rem *----*----* *----*----* *----*----* *----*----* ' Set mySelection = ActiveInspector.WordEditor.Application.Selection ' If mySelection.Range.Text = "" Then myChar = mySelection.MoveUp(4, 1, 1) ' 4: wdParagraph 1: wdExtend If myChar = 0 Then GoTo EspCfxSubExit End If End If ' myCount = mySelection.Range.Characters.Count mySelection.Collapse 1 ' wdCollapseStart Rem *----*----* *----*----* *----*----* *----*----* ' EspCfxSubEntry: If myCount <= 0 Then GoTo EspCfxSubExit ' With mySelection myChar = .MoveEndUntil(Cset:="x^_~", Count:=myCount) ' 「x^_~」の各文字を検索。 Select Case myChar Case 0 ' 「x^_~」の各文字が全くない場合。 mySelection.MoveRight Unit:=1, Count:=myCount, Extend:=0 ' 1: wdCharacter 0: wdMove mySelection.Collapse 0 ' wdCollapseEnd GoTo EspCfxSubExit Case 1 ' 選択した文字列の先頭に「x^_~」の各文字があった場合。 mySelection.MoveRight Unit:=1, Count:=1, Extend:=0 ' 1: wdCharacter 0: wdMove mySelection.Collapse 0 ' wdCollapseEnd myCount = myCount - 1 GoTo EspCfxSubEntry Case Else ' 選択した文字列の中に「x^_~」の各文字があった場合。 mySelection.MoveRight Unit:=1, Count:=1, Extend:=1 ' 1: wdCharacter 0: wdExtend myCount = myCount - mySelection.Range.Characters.Count mySelection.Collapse 0 ' wdCollapseEnd Call EspCfxType(mySelection) GoTo EspCfxSubEntry End Select End With Rem *----*----* *----*----* *----*----* *----*----* ' EspCfxSubExit: Set mySelection = Nothing End Sub ' EspCfx *----*----* *----*----* *----*----* *----*----* Sub EspCfxType(mySelection As Object) mySelection.MoveLeft Unit:=1, Count:=2, Extend:=1 ' 1: wdCharacter 1: wdExtend ' Select Case mySelection.Range.Text Case "a_": mySelection.TypeText ChrW(226) Case "e_": mySelection.TypeText ChrW(234) Case "i_": mySelection.TypeText ChrW(238) Case "o_": mySelection.TypeText ChrW(244) Case "u_": mySelection.TypeText ChrW(251) ' Case "A_": mySelection.TypeText ChrW(194) Case "E_": mySelection.TypeText ChrW(202) Case "I_": mySelection.TypeText ChrW(206) Case "O_": mySelection.TypeText ChrW(212) Case "U_": mySelection.TypeText ChrW(219) ' Case "cx": mySelection.TypeText ChrW(265) Case "gx": mySelection.TypeText ChrW(285) Case "hx": mySelection.TypeText ChrW(293) Case "jx": mySelection.TypeText ChrW(309) Case "sx": mySelection.TypeText ChrW(349) Case "ux": mySelection.TypeText ChrW(365) ' Case "Cx": mySelection.TypeText ChrW(264) Case "Gx": mySelection.TypeText ChrW(284) Case "Hx": mySelection.TypeText ChrW(292) Case "Jx": mySelection.TypeText ChrW(308) Case "Sx": mySelection.TypeText ChrW(348) Case "Ux": mySelection.TypeText ChrW(364) ' Case "c^": mySelection.TypeText ChrW(265) Case "g^": mySelection.TypeText ChrW(285) Case "h^": mySelection.TypeText ChrW(293) Case "j^": mySelection.TypeText ChrW(309) Case "s^": mySelection.TypeText ChrW(349) Case "u^": mySelection.TypeText ChrW(365) Case "u~": mySelection.TypeText ChrW(365) ' Case "C^": mySelection.TypeText ChrW(264) Case "G^": mySelection.TypeText ChrW(284) Case "H^": mySelection.TypeText ChrW(292) Case "J^": mySelection.TypeText ChrW(308) Case "S^": mySelection.TypeText ChrW(348) Case "U^": mySelection.TypeText ChrW(364) Case "U~": mySelection.TypeText ChrW(364) ' Case Else: mySelection.Collapse 0 ' wdCollapseEnd End Select End Sub ' EspCfxType *----*----* *----*----* *----*----* *----*----*