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 *----*----*    *----*----*    *----*----*    *----*----*
inserted by FC2 system