Declare Function GetAsyncKeyState Lib "User32.dll" (ByVal vKey As Long) As Long

Sub Espizo()
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem エスペラント語 代用文字 範囲内置換処理
  Rem 作譜：Hitrock Camellia Shinopy
  Rem 言語：Word VBA
  Rem 機能...
  Rem   エスペラント語代用文字を正書文字に置換する。
  Rem   エスペラント語正書文字を代用文字に置換する。
  Rem 注記...
  Rem   「Espizo」を起動して、ツールバーを追加し、コマンドボタンを押して、処理を実行する｡
  Rem   Win32 APIを利用：GetAsyncKeyState関数
  Rem   不具合あり。
  Rem     1. EspizoSuff実行後に、カーソル位置が選択範囲の末尾より1〜2文字分左になることがある。
  Rem     2. 文章が頁を跨いだ場合、文章入力時に画面が上下してチラつきが発生する。
  Rem       「.」で文章を区切るか、スクロールバーを上下させて表示位置を変えるなどの対処が必要。
  Rem 履歴...
  Rem   第01版：2004/12/12：作成。
  Rem   （...）
  Rem   第10版：2007/01/06：Word2007以降に対応するため、バルーン表示を廃止。ツールバー表示に変更。
  Rem   第11版：2007/08/25：リストボックスをドロップダウンリストに変更。
  Rem   第12版：2008/08/28：FaceIdを変更。（1611 => 1063）
  Rem   第13版：2009/03/29：打鍵起動処理を追加。（[x]あるいは[Space]キーで置換処理を起動）
  Rem   第14版：2009/05/05：EspizoAutoLoopプロシージャのSelect Case文にDoEventsを追加。
  Rem   第15版：2009/05/10：打鍵起動処理の内、[Space]キーでの処理を[Pause]キーで処理するよう変更。
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Dim myTitle As String
  Dim myBoolean As Boolean
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Rem 既定値の設定
  myTitle = "Espizo"
  myBoolean = True ' アプリケーションの終了時に自動的にツールバー削除する。
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Rem 同名ツールバーの削除
  On Error Resume Next
  CommandBars(myTitle).Delete
  On Error GoTo 0
  '
  Rem ステータスバーの表示
  Application.DisplayStatusBar = True
  '
  Call EspizoBlln(myTitle, myBoolean)
End Sub ' Espizo *----*----*    *----*----*    *----*----*    *----*----*

Sub EspizoBlln(myTitle As String, myBoolean As Boolean)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem ツールバー表示処理
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Dim myCmmdBar As CommandBar
  Dim myCtrlAuto As CommandBarControl
  Dim myCtrlBttn As CommandBarControl
  Dim myCtrlCboxItem As CommandBarControl
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Set myCmmdBar = CommandBars.Add(Name:=myTitle, Position:=msoBarTop, Temporary:=myBoolean)
  Set myCtrlAuto = myCmmdBar.Controls.Add(Type:=msoControlButton, Before:=1, Temporary:=myBoolean)
  Set myCtrlBttn = myCmmdBar.Controls.Add(Type:=msoControlButton, Before:=2, Temporary:=myBoolean)
  Set myCtrlCboxItem = myCmmdBar.Controls.Add(Type:=msoControlDropdown, Before:=3, Temporary:=myBoolean)
  ' Set myCtrlCboxItem = myCmmdBar.Controls.Add(Type:=msoControlComboBox, Before:=3, Temporary:=myBoolean)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  With myCtrlAuto
    .DescriptionText = "エスペラント語 代用文字 範囲内置換：選択した処理をキーを押して起動します。"
    .Style = msoButtonIcon
    .Caption = myTitle
    .TooltipText = "打鍵起動！"
    .FaceId = 6917
    .OnAction = "EspizoAuto"
  End With
  '
  With myCtrlBttn
    .DescriptionText = "エスペラント語 代用文字 範囲内置換：選択した処理を実行します。"
    .Style = msoButtonIcon
    .Caption = myTitle
    .TooltipText = "実行！"
    .FaceId = 1063
    .OnAction = "EspizoBttn"
  End With
  '
  With myCtrlCboxItem
    .DescriptionText = "実行する処理を選択します。"
    .Style = msoComboNormal
    .Caption = "処理"
    '
    .AddItem "^x記法", 1
    .AddItem "^記法", 2
    .AddItem "&;記法", 3
    .AddItem "^’記法", 4
    .AddItem "^h記法", 5
    .AddItem "===========", 6
    .AddItem "x代用表記", 7
    .AddItem "^代用表記", 8
    .AddItem "&;代用表記", 9
    .AddItem "===========", 10
    .AddItem "^接頭字記法", 11
    '
    .ListIndex = 1
    .TooltipText = "^x記法"
    .DropDownLines = 11
    .DropDownWidth = 200
    .OnAction = "EspizoCboxItem"
  End With
  '
  myCmmdBar.Visible = True
End Sub ' EspizoBlln *----*----*    *----*----*    *----*----*    *----*----*

Sub EspizoCboxItem(Optional myDummy As Boolean)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem [処理]コンボボックス処理
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  With CommandBars("Espizo").Controls(3)
    If .Text = "===========" Then
      .TooltipText = "処理が未選択です。"
    Else
      If .Text = "&;記法" Or .Text = "&;代用表記" Then
        .TooltipText = "&" & .Text
      Else
        .TooltipText = .Text
      End If
    End If
  End With
End Sub ' EspizoCboxItem *----*----*    *----*----*    *----*----*    *----*----*

Sub EspizoAuto(Optional myDummy As Boolean)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem 打鍵起動ボタン処理
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  With CommandBars("Espizo").Controls(1)
    If .FaceId = 6917 Then
      .FaceId = 6914
      .TooltipText = "打鍵起動 処理中。 実行:[x]/[Pause]キー  終了:[Esc]キー"
      Call EspizoAutoLoop("Espizo")
    Else
      .FaceId = 6917
      .TooltipText = "打鍵起動！"
    End If
  End With
End Sub ' EspizoAuto *----*----*    *----*----*    *----*----*    *----*----*

Sub EspizoBttn(Optional myDummy As Boolean)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem 各ボタン処理
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Dim myTitle As String
  Dim myBttn As Long
  Dim myLabel As String
  Dim c  As Long
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  myTitle = "Espizo"
  '
  With CommandBars(myTitle).Controls(3)
    myLabel = .Text
    myBttn = .ListIndex
  End With
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Select Case myBttn
    Case 0, 6, 10
      GoTo EspizoBttnSubExit
  End Select
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Application.ScreenUpdating = False
  '
  If Selection.Range.Text = "" Then
    c = Selection.MoveUp(wdParagraph, 1, wdExtend)
    If c = 0 Then
      GoTo EspizoBttnSubExit
    End If
  End If
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
EspizoBttnSubEntry:
  Select Case myBttn
    Case 1
      Call EspizoSffx("x")
    Case 2
      Call EspizoSffx("^")
    Case 3
      Call EspizoUcs2
    Case 4
      Call EspizoSffx("'")
    Case 5
      Call EspizoSffx("h")
    Case 7
      Call EspizoSuff("x")
    Case 8
      Call EspizoSuff("^")
    Case 9
      Call EspizoSuff("")
    Case 11
      Call EspizoPrfx("^") ' ^接頭字記法
  End Select
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
EspizoBttnSubExit:
  Selection.Collapse wdCollapseEnd
  '
  Rem 続けて処理する場合に備える。（〜Excel 2003）
  If Val(Application.Version) < 12 Then
    CommandBars(myTitle).Enabled = False
    CommandBars(myTitle).Enabled = True
  End If
  '
  Application.ScreenUpdating = True
  '
  Select Case myBttn
    Case 1 To 5, 7 To 9, 11
      Application.StatusBar = myTitle & "：" & "処理完了！" & "[ " & myLabel & " ]"
  End Select
End Sub ' EspizoBttn *----*----*    *----*----*    *----*----*    *----*----*

Sub EspizoAutoLoop(myTitle As String)
  Do
    If CommandBars(myTitle).Controls(1).FaceId = 6917 Then Exit Do
    '
    Select Case True
      Case GetAsyncKeyState(vbKeyX) <> 0
        DoEvents
        If CommandBars(myTitle).Controls(3).Text = "^x記法" Then
          CommandBars(myTitle).Controls(1).FaceId = 2151
          Application.ScreenUpdating = False
          Selection.MoveLeft Unit:=wdCharacter, Count:=2, Extend:=wdExtend
          Call EspizoBttn
          Application.ScreenUpdating = True
          CommandBars(myTitle).Controls(1).FaceId = 6914
        End If
      Case GetAsyncKeyState(vbKeyPause) <> 0
        DoEvents
        CommandBars(myTitle).Controls(1).FaceId = 2151
        Application.ScreenUpdating = False
        Selection.MoveLeft Unit:=wdSentence, Count:=1, Extend:=wdExtend
        Call EspizoBttn
        Application.ScreenUpdating = True
        CommandBars(myTitle).Controls(1).FaceId = 6914
      Case GetAsyncKeyState(vbKeyEscape) <> 0
        DoEvents
        CommandBars(myTitle).Controls(1).FaceId = 6917
        CommandBars(myTitle).Controls(1).TooltipText = "打鍵起動！"
        Exit Do
    End Select
    '
    DoEvents
  Loop
End Sub ' EspizoAutoLoop *----*----*    *----*----*    *----*----*    *----*----*

Sub EspizoSffx(mySffx As String)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem 各接尾字記法処理
  Rem mySffxの値...
  Rem   「^」の場合：^接尾字付き文字を置換する。
  Rem   「x」の場合：^接尾字付き文字・x接尾字付き文字ともに置換する。
  Rem   「'」の場合：^接尾字付き文字・'接尾字付き文字ともに置換する。
  Rem   「h」の場合：^接尾字付き文字・h接尾字付き文字ともに置換する。
  Rem 注記...
  Rem   参照設定する場合：Microsoft VBScript Regular Expressions 5.5
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  If Selection.Range.Characters.Count < 2 Then Exit Sub
  '
  Dim i As Long
  Dim C As Integer
  '
  Dim myRange As Range
  Dim myChrsFound As Characters
  Dim myText As String
  Dim myLen As Long
  '
  Dim myRegExp As Variant ' VBScript_RegExp_55.RegExp
  Dim myMatches As Variant ' MatchCollection
  Dim myMatch As Variant ' Match
  Dim myPttn As String
  '
  Set myRegExp = CreateObject("VBScript.RegExp") ' New VBScript_RegExp_55.RegExp
  Set myRange = Selection.Range
  Selection.Collapse wdCollapseStart
  '
EspizoSffxSubEntry:
  Rem パターンを設定
  Select Case mySffx
    Case "x"
      myPttn = "([AEIOaeio]{1}[\_\^]{1})|([Uu]{1}[\_~]{1})|([CGHJSUcghjsu]{1}[x\^]{1})"
    Case "^"
      myPttn = "([AEIOaeio]{1}[\_\^]{1})|([Uu]{1}[\_~]{1})|([CGHJSUcghjsu]{1}[\^]{1})"
    Case "'"
      myPttn = "([AEIOaeio]{1}[\_\^]{1})|([Uu]{1}[\_~]{1})|([CGHJSUcghjsu]{1}[\u0027\u2019\^]{1})"
    Case "h"
      myPttn = "([AEIOaeio]{1}[\_\^]{1})|([Uu]{1}[\_~]{1})|([CGHJSUcghjsu]{1}[h\^]{1})"
  End Select
  '
  With myRegExp
    .Pattern = myPttn ' パターンを指定
    .IgnoreCase = False ' 大文字小文字を区別する。
    .Global = True ' 文字列全体を検索
  End With
  Set myMatches = myRegExp.Execute(myRange.Text)
  '
  If myMatches.Count = 0 Then GoTo EspizoSffxSubExit
  '
  With Selection.Find
    For i = 0 To myMatches.Count - 1
      .ClearFormatting
      .Text = myMatches.Item(i).Value
      .Forward = True
      .Wrap = wdFindStop
      .MatchCase = True
      .MatchAllWordForms = False
      .MatchSoundsLike = False
      .MatchFuzzy = False
      .MatchWildcards = False
      .Execute
      '
      Set myChrsFound = Selection.Range.Characters
      myText = myChrsFound.Parent.Text
      myLen = Len(myText)
      '
      Select Case myChrsFound.First.Next.Text
        Case "^"
          Select Case myChrsFound.First.Text
            Case "C", "G", "H", "J", "S", "U", "c", "g", "h", "j", "s", "u"
              Call EspizoCghjsu("", "^", myText)
            Case "A", "E", "I", "O", "a", "e", "i", "o"
              Call EspizoAeiou("", "^", myText)
          End Select
        Case "x"
          Select Case myChrsFound.First.Text
            Case "C", "G", "H", "J", "S", "U", "c", "g", "h", "j", "s", "u"
              Call EspizoCghjsu("", "x", myText)
          End Select
        Case "'", ChrW(8217) ' 単一引用符
          Select Case myChrsFound.First.Text
            Case "C", "G", "H", "J", "S", "U", "c", "g", "h", "j", "s", "u"
              Call EspizoCghjsu("", "'", myText)
              Call EspizoCghjsu("", ChrW(8217), myText)
          End Select
        Case "h"
          Select Case myChrsFound.First.Text
            Case "C", "G", "H", "J", "S", "U", "c", "g", "h", "j", "s", "u"
              Call EspizoCghjsu("", "h", myText)
          End Select
        Case "_"
          Select Case myChrsFound.First.Text
            Case "A", "E", "I", "O", "U", "a", "e", "i", "o", "u"
              Call EspizoAeiou("", "_", myText)
          End Select
        Case "~"
          Select Case myChrsFound.First.Text
            Case "U", "u"
              Call EspizoCghjsu("", "^", myText)
          End Select
      End Select
      '
      If myLen <> Len(myText) Then
        Rem 置換する文字列があった場合。
        myChrsFound.First.Text = myText
        myChrsFound.First.Next.Text = ""
      End If
      '
      C = Int((i + 1) * 100 / myMatches.Count)
      Application.StatusBar = "Espizo" & "：処理中" & " " & Format(C, "##0") & "%"
    Next ' i
  End With
  '
EspizoSffxSubExit:
  myRange.Select ' 当初の選択範囲。
  Selection.Collapse wdCollapseEnd
  '
  Set myRegExp = Nothing
  Set myMatches = Nothing
  '
  Set myRange = Nothing
  Set myChrsFound = Nothing
End Sub ' EspizoSffx *----*----*    *----*----*    *----*----*    *----*----*

Sub EspizoUcs2(Optional myDummy As Boolean)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem 十進符号記法処理
  Rem 「&〜;」（UCS_2十進符号表記）を検索し、文字列を置換する。
  Rem 注記...
  Rem   参照設定する場合：Microsoft VBScript Regular Expressions 5.5
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  If Selection.Range.Characters.Count < 3 Then Exit Sub
  '
  Dim i As Long
  Dim j As Integer
  Dim C As Integer
  '
  Dim myRange As Range
  Dim myChrsFound As Characters
  Dim myText As String
  Dim myLen As Long
  '
  Dim myRegExp As Variant ' VBScript_RegExp_55.RegExp
  Dim myMatches As Variant ' MatchCollection
  Dim myMatch As Variant ' Match
  '
  Set myRegExp = CreateObject("VBScript.RegExp") ' New VBScript_RegExp_55.RegExp
  Set myRange = Selection.Range
  Selection.Collapse wdCollapseStart
  '
EspizoUcs2SubEntry:
  With myRegExp
    .Pattern = "\&{1}[\#A-Za-z0-9]{1,10}\;{1}" ' 「&〜;」を指定
    .IgnoreCase = False ' 大文字小文字を区別する。
    .Global = True ' 文字列全体を検索
  End With
  Set myMatches = myRegExp.Execute(myRange.Text)
  '
  If myMatches.Count = 0 Then GoTo EspizoUcs2SubExit
  '
  With Selection.Find
    For i = 0 To myMatches.Count - 1
      .ClearFormatting
      .Text = myMatches.Item(i).Value
      .Forward = True
      .Wrap = wdFindStop
      .MatchCase = True
      .MatchAllWordForms = False
      .MatchSoundsLike = False
      .MatchFuzzy = False
      .MatchWildcards = False
      .Execute
      '
      Set myChrsFound = Selection.Range.Characters
      myText = myChrsFound.Parent.Text
      myLen = Len(myText)
      '
      Call EspizoUcAeiou(myText)
      Call EspizoUcCghjsu(myText)
      Call EspizoUcOthers(myText)
      '
      If myLen <> Len(myText) Then
        Rem 置換する文字列があった場合。
        Rem myChrsFound.Parent.Text = myText ' 不可！
        Rem ↑文字列の最後に置換する文字がある場合、
        Rem 処理後のカーソル位置がズレる。（↓苦肉の策！）
        myChrsFound.First.Text = myText
        For j = 2 To myLen
          myChrsFound.First.Next.Text = ""
        Next ' j
      End If
      '
      C = Int((i + 1) * 100 / myMatches.Count)
      Application.StatusBar = "Espizo" & "：処理中" & " " & Format(C, "##0") & "%"
    Next ' i
  End With
  '
EspizoUcs2SubExit:
  myRange.Select ' 当初の選択範囲。
  Selection.Collapse wdCollapseEnd
  '
  Set myRegExp = Nothing
  Set myMatches = Nothing
  '
  Set myRange = Nothing
  Set myChrsFound = Nothing
End Sub ' EspizoUcs2 *----*----*    *----*----*    *----*----*    *----*----*

Sub EspizoSuff(mySffx As String)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem 代用文字表記処理
  Rem 各国文字など各種の文字（Unicodeで160〜511の範囲）を検索し、
  Rem (1)：検索した文字列を、UCS_2十進表記に置換する。
  Rem (2)：エスペラント語文字を、指定した文字列接尾字付きの文字列に置換する。
  Rem (3)：屈音符付き母音字は、「_」接尾字付き文字列に置換する。
  Rem mySffxの値...
  Rem   「」の場合：検索した総ての文字列を対象に(1)処理。
  Rem   「^」の場合：(3)処理をし、(2)処理で「^」接尾字付きの文字列に置換する。
  Rem   「x」の場合：(3)処理をし、(2)処理で「x」接尾字付きの文字列に置換する。
  Rem 注記...
  Rem   参照設定する場合：Microsoft VBScript Regular Expressions 5.5
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  If Selection.Range.Characters.Count < 1 Then Exit Sub
  '
  Dim i As Long
  Dim C  As Integer
  '
  Dim myRange As Range
  Dim myChrsFound As Characters
  Dim myText As String
  Dim myLen As Long
  '
  Dim myRegExp As Variant ' VBScript_RegExp_55.RegExp
  Dim myMatches As Variant ' MatchCollection
  Dim myMatch As Variant ' Match
  '
  Set myRegExp = CreateObject("VBScript.RegExp") ' New VBScript_RegExp_55.RegExp
  Set myRange = Selection.Range
  '
  Selection.Collapse wdCollapseStart
  '
EzpizoSuffSubEntry:
  With myRegExp
    .Pattern = "[" & ChrW(160) & "-" & ChrW(511) & "]{1}"
    .IgnoreCase = False ' 大文字小文字を区別する。
    .Global = True ' 文字列全体を検索
  End With
  Set myMatches = myRegExp.Execute(myRange.Text)
  '
  If myMatches.Count = 0 Then GoTo EzpizoSuffSubExit
  '
  With Selection.Find
    For i = 0 To myMatches.Count - 1
      .ClearFormatting
      .Text = myMatches.Item(i).Value
      .Forward = True
      .Wrap = wdFindStop
      .MatchCase = True
      .MatchAllWordForms = False
      .MatchSoundsLike = False
      .MatchFuzzy = False
      .MatchWildcards = False
      .Execute
      '
      Set myChrsFound = Selection.Range.Characters
      myText = myChrsFound.Parent.Text
      myLen = Len(myText)
      '
      If mySffx = "" Then
        Call EspizoRvOthers(myText)
      Else
        Select Case myText
          Case ChrW(194), ChrW(202), ChrW(206), ChrW(212), ChrW(219)
            Call EspizoRvAeiou("", "_", myText)
          Case ChrW(226), ChrW(234), ChrW(238), ChrW(244), ChrW(251)
            Call EspizoRvAeiou("", "_", myText)
          Case ChrW(264), ChrW(284), ChrW(292), ChrW(308), ChrW(348), ChrW(364)
            Call EspizoRvCghjsu("", mySffx, myText)
          Case ChrW(265), ChrW(285), ChrW(293), ChrW(309), ChrW(349), ChrW(365)
            Call EspizoRvCghjsu("", mySffx, myText)
          Case Else
            Call EspizoRvOthers(myText)
        End Select
      End If
      '
      If myLen <> Len(myText) Then
        Rem 置換する文字列があった場合。
        myChrsFound.Parent.Text = myText
      End If
      Call Selection.MoveRight(wdCharacter, Len(myText), wdMove)
      '
      C = Int((i + 1) * 100 / myMatches.Count)
      Application.StatusBar = "Espizo" & "：処理中" & " " & Format(C, "##0") & "%"
    Next ' i
  End With
  '
EzpizoSuffSubExit:
  myRange.Select ' 当初の選択範囲。
  Selection.Collapse wdCollapseEnd
  '
  Set myRegExp = Nothing
  Set myMatches = Nothing
  '
  Set myRange = Nothing
  Set myChrsFound = Nothing
End Sub ' EspizoSuff *----*----*    *----*----*    *----*----*    *----*----*

Sub EspizoPrfx(myPrfx As String)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem 各接頭尾字記法処理
  Rem myPrfxの値...
  Rem   「^」の場合：^接尾字付き文字を置換する。
  Rem 注記...
  Rem   参照設定する場合：Microsoft VBScript Regular Expressions 5.5
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  If Selection.Range.Characters.Count < 2 Then Exit Sub
  '
  Dim i As Long
  Dim C As Integer
  '
  Dim myRange As Range
  Dim myChrsFound As Characters
  Dim myText As String
  Dim myLen As Long
  '
  Dim myRegExp As Variant ' VBScript_RegExp_55.RegExp
  Dim myMatches As Variant ' MatchCollection
  Dim myMatch As Variant ' Match
  Dim myPttn As String
  '
  Set myRegExp = CreateObject("VBScript.RegExp") ' New VBScript_RegExp_55.RegExp
  Set myRange = Selection.Range
  Selection.Collapse wdCollapseStart
  '
EspizoPrfxSubEntry:
  Rem パターンを設定
  Select Case myPrfx
    Case "^"
      myPttn = "([\_\^]{1}[AEIOaeio]{1})|([\_~]{1}[Uu]{1})|([\^]{1}[CGHJSUcghjsu]{1})"
  End Select
  '
  With myRegExp
    .Pattern = myPttn ' パターンを指定
    .IgnoreCase = False ' 大文字小文字を区別する。
    .Global = True ' 文字列全体を検索
  End With
  Set myMatches = myRegExp.Execute(myRange.Text)
  '
  If myMatches.Count = 0 Then GoTo EspizoPrfxSubExit
  '
  With Selection.Find
    For i = 0 To myMatches.Count - 1
      .ClearFormatting
      If Left(myMatches.Item(i).Value, 1) = "^" Then
        .Text = "^" & myMatches.Item(i).Value
      Else
        .Text = myMatches.Item(i).Value
      End If
      .Forward = True
      .Wrap = wdFindStop
      .MatchCase = True
      .MatchAllWordForms = False
      .MatchSoundsLike = False
      .MatchFuzzy = False
      .MatchWildcards = False
      .Execute
      '
      Set myChrsFound = Selection.Range.Characters
      myText = myChrsFound.Parent.Text
      myLen = Len(myText)
      '
      Select Case myChrsFound.First.Text
        Case "^"
          Select Case myChrsFound.Last.Text
            Case "C", "G", "H", "J", "S", "U", "c", "g", "h", "j", "s", "u"
              Call EspizoCghjsu("^", "", myText)
            Case "A", "E", "I", "O", "a", "e", "i", "o"
              Call EspizoAeiou("^", "", myText)
          End Select
        Case "_"
          Select Case myChrsFound.Last.Text
            Case "A", "E", "I", "O", "U", "a", "e", "i", "o", "u"
              Call EspizoAeiou("_", "", myText)
          End Select
        Case "~"
          Select Case myChrsFound.Last.Text
            Case "U", "u"
              Call EspizoCghjsu("^", "", myText)
          End Select
      End Select
      '
      If myLen <> Len(myText) Then
        Rem 置換する文字列があった場合。
        myChrsFound.First.Text = myText
        myChrsFound.First.Next.Text = ""
      End If
      '
      C = Int((i + 1) * 100 / myMatches.Count)
      Application.StatusBar = "Espizo" & "：処理中" & " " & Format(C, "##0") & "%"
    Next ' i
  End With
  '
EspizoPrfxSubExit:
  myRange.Select ' 当初の選択範囲。
  Selection.Collapse wdCollapseEnd
  '
  Set myRegExp = Nothing
  Set myMatches = Nothing
  '
  Set myRange = Nothing
  Set myChrsFound = Nothing
End Sub ' EspizoPrfx *----*----*    *----*----*    *----*----*    *----*----*

Sub EspizoAeiou(prefixC As String, suffixC As String, myText As String)
  myText = Replace(myText, prefixC & "A" & suffixC, ChrW(194)) ' A^
  myText = Replace(myText, prefixC & "E" & suffixC, ChrW(202)) ' E^
  myText = Replace(myText, prefixC & "I" & suffixC, ChrW(206)) ' I^
  myText = Replace(myText, prefixC & "O" & suffixC, ChrW(212)) ' O^
  If prefixC = "" Then
    myText = Replace(myText, "U_", ChrW(219))                  ' U_
  Else
    myText = Replace(myText, "_U", ChrW(219))                  ' U_
  End If
  '
  myText = Replace(myText, prefixC & "a" & suffixC, ChrW(226)) ' a^
  myText = Replace(myText, prefixC & "e" & suffixC, ChrW(234)) ' e^
  myText = Replace(myText, prefixC & "i" & suffixC, ChrW(238)) ' i^
  myText = Replace(myText, prefixC & "o" & suffixC, ChrW(244)) ' o^
  If prefixC = "" Then
    myText = Replace(myText, "u_", ChrW(251))                  ' u_
  Else
    myText = Replace(myText, "_u", ChrW(251))                  ' u_
  End If
End Sub ' EspizoAeiou *----*----*    *----*----*    *----*----*    *----*----*

Sub EspizoCghjsu(prefixC As String, suffixC As String, myText As String)
  myText = Replace(myText, prefixC & "C" & suffixC, ChrW(264)) ' C^
  myText = Replace(myText, prefixC & "G" & suffixC, ChrW(284)) ' G^
  myText = Replace(myText, prefixC & "H" & suffixC, ChrW(292)) ' H^
  myText = Replace(myText, prefixC & "J" & suffixC, ChrW(308)) ' J^
  myText = Replace(myText, prefixC & "S" & suffixC, ChrW(348)) ' S^
  If prefixC = "" Then
    myText = Replace(myText, "U^", ChrW(364))                  ' U^
    myText = Replace(myText, "U~", ChrW(364))                  ' U^
    Select Case suffixC
      Case "x"
        myText = Replace(myText, "Ux", ChrW(364))              ' U^
      Case "h"
        myText = Replace(myText, "Uh", ChrW(364))              ' U^
      Case "'"
        myText = Replace(myText, "U'", ChrW(364))              ' U^
      Case ChrW(8217)
        myText = Replace(myText, "U" & ChrW(8217), ChrW(364))  ' U^
    End Select
  Else
    myText = Replace(myText, "~U", ChrW(364))                  ' U^
    If Not (prefixC = "q" Or prefixC = "y") Then
      myText = Replace(myText, prefixC & "U", ChrW(364))       ' U^
    End If
    Select Case prefixC
      Case "x"
        myText = Replace(myText, "xW", ChrW(364))              ' U^
      Case "q"
        myText = Replace(myText, "qW", ChrW(364))              ' U^
      Case "y"
        myText = Replace(myText, "yW", ChrW(364))              ' U^
    End Select
  End If
  '
  myText = Replace(myText, prefixC & "c" & suffixC, ChrW(265)) ' c^
  myText = Replace(myText, prefixC & "g" & suffixC, ChrW(285)) ' g^
  myText = Replace(myText, prefixC & "h" & suffixC, ChrW(293)) ' h^
  myText = Replace(myText, prefixC & "j" & suffixC, ChrW(309)) ' j^
  myText = Replace(myText, prefixC & "s" & suffixC, ChrW(349)) ' s^
  If prefixC = "" Then
    myText = Replace(myText, "u^", ChrW(365))                  ' u^
    myText = Replace(myText, "u~", ChrW(365))                  ' u^
    Select Case suffixC
      Case "x"
        myText = Replace(myText, "ux", ChrW(365))              ' u^
      Case "h"
        myText = Replace(myText, "uh", ChrW(365))              ' u^
      Case "'"
        myText = Replace(myText, "u'", ChrW(365))              ' U^
      Case ChrW(8217)
        myText = Replace(myText, "u" & ChrW(8217), ChrW(365))  ' U^
    End Select
  Else
    myText = Replace(myText, "~u", ChrW(365))                  ' u^
    If Not (prefixC = "q" Or prefixC = "y") Then
      myText = Replace(myText, prefixC & "u", ChrW(365))       ' u^
    End If
    Select Case prefixC
      Case "x"
        myText = Replace(myText, "xw", ChrW(365))              ' u^
      Case "q"
        myText = Replace(myText, "qw", ChrW(365))              ' u^
      Case "y"
        myText = Replace(myText, "yw", ChrW(365))              ' u^
    End Select
  End If
End Sub ' EspizoCghjsu *----*----*    *----*----*    *----*----*    *----*----*

Sub EspizoUcAeiou(myText As String)
  myText = Replace(myText, "&Acirc;", ChrW(194)) ' A_
  myText = Replace(myText, "&Ecirc;", ChrW(202)) ' E_
  myText = Replace(myText, "&Icirc;", ChrW(206)) ' I_
  myText = Replace(myText, "&Ocirc;", ChrW(212)) ' O_
  myText = Replace(myText, "&Ucirc;", ChrW(219)) ' U_
  '
  myText = Replace(myText, "&acirc;", ChrW(226)) ' a_
  myText = Replace(myText, "&ecirc;", ChrW(234)) ' e_
  myText = Replace(myText, "&icirc;", ChrW(238)) ' i_
  myText = Replace(myText, "&ocirc;", ChrW(244)) ' o_
  myText = Replace(myText, "&ucirc;", ChrW(251)) ' u_
End Sub ' EspizoUcAeiou *----*----*    *----*----*    *----*----*    *----*----*

Sub EspizoUcCghjsu(myText As String)
  Rem UTF
  myText = Replace(myText, "&#264;", ChrW(264)) ' C^
  myText = Replace(myText, "&#284;", ChrW(284)) ' G^
  myText = Replace(myText, "&#292;", ChrW(292)) ' H^
  myText = Replace(myText, "&#308;", ChrW(308)) ' J^
  myText = Replace(myText, "&#348;", ChrW(348)) ' S^
  myText = Replace(myText, "&#364;", ChrW(364)) ' U^
  '
  myText = Replace(myText, "&#265;", ChrW(265)) ' c^
  myText = Replace(myText, "&#285;", ChrW(285)) ' g^
  myText = Replace(myText, "&#293;", ChrW(293)) ' h^
  myText = Replace(myText, "&#309;", ChrW(309)) ' j^
  myText = Replace(myText, "&#349;", ChrW(349)) ' s^
  myText = Replace(myText, "&#365;", ChrW(365)) ' u^
  '
  Exit Sub
  Rem Latin-3
  myText = Replace(myText, ChrW(198), ChrW(264)) ' C^
  myText = Replace(myText, ChrW(216), ChrW(284)) ' G^
  myText = Replace(myText, ChrW(166), ChrW(292)) ' H^
  myText = Replace(myText, ChrW(172), ChrW(308)) ' J^
  myText = Replace(myText, ChrW(222), ChrW(348)) ' S^
  myText = Replace(myText, ChrW(221), ChrW(364)) ' U^
  '
  myText = Replace(myText, ChrW(230), ChrW(265)) ' c^
  myText = Replace(myText, ChrW(248), ChrW(285)) ' g^
  myText = Replace(myText, ChrW(182), ChrW(293)) ' h^
  myText = Replace(myText, ChrW(188), ChrW(309)) ' j^
  myText = Replace(myText, ChrW(254), ChrW(349)) ' s^
  myText = Replace(myText, ChrW(253), ChrW(365)) ' u^
End Sub ' EspizoUcCghjsu *----*----*    *----*----*    *----*----*    *----*----*

Sub EspizoUcOthers(myText As String)
  Dim i As Integer
  Rem
  myText = Replace(myText, "&nbsp;", ChrW(160))
  myText = Replace(myText, "&iexcl;", ChrW(161))
  myText = Replace(myText, "&cent;", ChrW(162))
  myText = Replace(myText, "&pound;", ChrW(163))
  myText = Replace(myText, "&curren;", ChrW(164))
  myText = Replace(myText, "&yen;", ChrW(165))
  myText = Replace(myText, "&brvbar;", ChrW(166))
  Rem
  Rem
  myText = Replace(myText, "&copy;", ChrW(169))
  myText = Replace(myText, "&ordf;", ChrW(170))
  myText = Replace(myText, "&laquo;", ChrW(171))
  myText = Replace(myText, "&not;", ChrW(172))
  myText = Replace(myText, "&shy;", ChrW(173))
  myText = Replace(myText, "&reg;", ChrW(174))
  myText = Replace(myText, "&macr;", ChrW(175))
  Rem
  Rem
  myText = Replace(myText, "&sup2;", ChrW(178))
  myText = Replace(myText, "&sup3;", ChrW(179))
  Rem
  myText = Replace(myText, "&micro;", ChrW(181))
  Rem
  myText = Replace(myText, "&middot;", ChrW(183))
  myText = Replace(myText, "&cedil;", ChrW(184))
  myText = Replace(myText, "&sup1;", ChrW(185))
  myText = Replace(myText, "&ordm;", ChrW(186))
  myText = Replace(myText, "&raquo;", ChrW(187))
  myText = Replace(myText, "&frac14;", ChrW(188))
  myText = Replace(myText, "&frac12;", ChrW(189))
  myText = Replace(myText, "&frac34;", ChrW(190))
  myText = Replace(myText, "&iquest;", ChrW(191))
  myText = Replace(myText, "&Agrave;", ChrW(192))
  myText = Replace(myText, "&Aacute;", ChrW(193))
  myText = Replace(myText, "&Acirc;", ChrW(194))
  myText = Replace(myText, "&Atilde;", ChrW(195))
  myText = Replace(myText, "&Auml;", ChrW(196))
  myText = Replace(myText, "&Aring;", ChrW(197))
  myText = Replace(myText, "&AElig;", ChrW(198))
  myText = Replace(myText, "&Ccedil;", ChrW(199))
  myText = Replace(myText, "&Egrave;", ChrW(200))
  myText = Replace(myText, "&Eacute;", ChrW(201))
  myText = Replace(myText, "&Ecirc;", ChrW(202))
  myText = Replace(myText, "&Euml;", ChrW(203))
  myText = Replace(myText, "&Igrave;", ChrW(204))
  myText = Replace(myText, "&Iacute;", ChrW(205))
  myText = Replace(myText, "&Icirc;", ChrW(206))
  myText = Replace(myText, "&Iuml;", ChrW(207))
  myText = Replace(myText, "&ETH;", ChrW(208))
  myText = Replace(myText, "&Ntilde;", ChrW(209))
  myText = Replace(myText, "&Ograve;", ChrW(210))
  myText = Replace(myText, "&Oacute;", ChrW(211))
  myText = Replace(myText, "&Ocirc;", ChrW(212))
  myText = Replace(myText, "&Otilde;", ChrW(213))
  myText = Replace(myText, "&Ouml;", ChrW(214))
  Rem
  myText = Replace(myText, "&Oslash;", ChrW(216))
  myText = Replace(myText, "&Ugrave;", ChrW(217))
  myText = Replace(myText, "&Uacute;", ChrW(218))
  myText = Replace(myText, "&Ucirc;", ChrW(219))
  myText = Replace(myText, "&Uuml;", ChrW(220))
  myText = Replace(myText, "&Yacute;", ChrW(221))
  myText = Replace(myText, "&THORN;", ChrW(222))
  myText = Replace(myText, "&szlig;", ChrW(223))
  myText = Replace(myText, "&agrave;", ChrW(224))
  myText = Replace(myText, "&aacute;", ChrW(225))
  myText = Replace(myText, "&acirc;", ChrW(226))
  myText = Replace(myText, "&atilde;", ChrW(227))
  myText = Replace(myText, "&auml;", ChrW(228))
  myText = Replace(myText, "&aring;", ChrW(229))
  myText = Replace(myText, "&aelig;", ChrW(230))
  myText = Replace(myText, "&ccedil;", ChrW(231))
  myText = Replace(myText, "&egrave;", ChrW(232))
  myText = Replace(myText, "&eacute;", ChrW(233))
  myText = Replace(myText, "&ecirc;", ChrW(234))
  myText = Replace(myText, "&euml;", ChrW(235))
  myText = Replace(myText, "&igrave;", ChrW(236))
  myText = Replace(myText, "&iacute;", ChrW(237))
  myText = Replace(myText, "&icirc;", ChrW(238))
  myText = Replace(myText, "&iuml;", ChrW(239))
  myText = Replace(myText, "&eth;", ChrW(240))
  myText = Replace(myText, "&ntilde;", ChrW(241))
  myText = Replace(myText, "&ograve;", ChrW(242))
  myText = Replace(myText, "&oacute;", ChrW(243))
  myText = Replace(myText, "&ocirc;", ChrW(244))
  myText = Replace(myText, "&otilde;", ChrW(245))
  myText = Replace(myText, "&ouml;", ChrW(246))
  Rem
  myText = Replace(myText, "&oslash;", ChrW(248))
  myText = Replace(myText, "&ugrave;", ChrW(249))
  myText = Replace(myText, "&uacute;", ChrW(250))
  myText = Replace(myText, "&ucirc;", ChrW(251))
  myText = Replace(myText, "&uuml;", ChrW(252))
  myText = Replace(myText, "&yacute;", ChrW(253))
  myText = Replace(myText, "&thorn;", ChrW(254))
  myText = Replace(myText, "&yuml;", ChrW(255))
  '
  For i = 256 To 511
    myText = Replace(myText, "&#" & i & ";", ChrW(i))
  Next ' i
End Sub ' EspizoUcOthers *----*----*    *----*----*    *----*----*    *----*----*

Sub EspizoRvAeiou(prefixC As String, suffixC As String, myText As String)
  myText = Replace(myText, ChrW(194), prefixC & "A" & suffixC) ' A^
  myText = Replace(myText, ChrW(202), prefixC & "E" & suffixC) ' E^
  myText = Replace(myText, ChrW(206), prefixC & "I" & suffixC) ' I^
  myText = Replace(myText, ChrW(212), prefixC & "O" & suffixC) ' O^
  If prefixC = "" Then
    myText = Replace(myText, ChrW(219), "U_")                  ' U_
  Else
    myText = Replace(myText, ChrW(219), "_U")                  ' U_
  End If
  '
  myText = Replace(myText, ChrW(226), prefixC & "a" & suffixC) ' a^
  myText = Replace(myText, ChrW(234), prefixC & "e" & suffixC) ' e^
  myText = Replace(myText, ChrW(238), prefixC & "i" & suffixC) ' i^
  myText = Replace(myText, ChrW(244), prefixC & "o" & suffixC) ' o^
  If prefixC = "" Then
    myText = Replace(myText, ChrW(251), "u_")                  ' u_
  Else
    myText = Replace(myText, ChrW(251), "_u")                  ' u_
  End If
End Sub ' EspizoRvAeiou *----*----*    *----*----*    *----*----*    *----*----*

Sub EspizoRvCghjsu(prefixC As String, suffixC As String, myText As String)
  myText = Replace(myText, ChrW(264), prefixC & "C" & suffixC) ' C^
  myText = Replace(myText, ChrW(284), prefixC & "G" & suffixC) ' G^
  myText = Replace(myText, ChrW(292), prefixC & "H" & suffixC) ' H^
  myText = Replace(myText, ChrW(308), prefixC & "J" & suffixC) ' J^
  myText = Replace(myText, ChrW(348), prefixC & "S" & suffixC) ' S^
  If prefixC = "" Then
    Select Case suffixC
      Case "x"
        myText = Replace(myText, ChrW(364), "Ux")              ' U^
      Case "h"
        myText = Replace(myText, ChrW(364), "Uh")              ' U^
      Case Else
        myText = Replace(myText, ChrW(364), "U^")              ' U^
    End Select
  Else
    If Not (prefixC = "q" Or prefixC = "y") Then
      myText = Replace(myText, ChrW(364), "^U")                ' U^
    End If
    Select Case prefixC
      Case "x"
        myText = Replace(myText, ChrW(364), "xW")              ' U^
      Case "q"
        myText = Replace(myText, ChrW(364), "qW")              ' U^
      Case "y"
        myText = Replace(myText, ChrW(364), "yW")              ' U^
      Case Else
        myText = Replace(myText, ChrW(364), "^U")              ' U^
    End Select
  End If
  '
  myText = Replace(myText, ChrW(265), prefixC & "c" & suffixC) ' c^
  myText = Replace(myText, ChrW(285), prefixC & "g" & suffixC) ' g^
  myText = Replace(myText, ChrW(293), prefixC & "h" & suffixC) ' h^
  myText = Replace(myText, ChrW(309), prefixC & "j" & suffixC) ' j^
  myText = Replace(myText, ChrW(349), prefixC & "s" & suffixC) ' s^
  If prefixC = "" Then
    Select Case suffixC
      Case "x"
        myText = Replace(myText, ChrW(365), "ux")              ' u^
      Case "h"
        myText = Replace(myText, ChrW(365), "uh")              ' u^
      Case Else
        myText = Replace(myText, ChrW(365), "u^")              ' u^
    End Select
  Else
    If Not (prefixC = "q" Or prefixC = "y") Then
      myText = Replace(myText, ChrW(365), "^u")                ' u^
    End If
    Select Case prefixC
      Case "x"
        myText = Replace(myText, ChrW(365), "xw")              ' u^
      Case "q"
        myText = Replace(myText, ChrW(365), "qw")              ' u^
      Case "y"
        myText = Replace(myText, ChrW(365), "yw")              ' u^
      Case Else
        myText = Replace(myText, ChrW(365), "^u")              ' u^
    End Select
  End If
End Sub ' EspizoRvCghjsu *----*----*    *----*----*    *----*----*    *----*----*

Sub EspizoRvOthers(myText As String)
  Dim i As Integer
  Rem
  myText = Replace(myText, ChrW(160), "&nbsp;")
  myText = Replace(myText, ChrW(161), "&iexcl;")
  myText = Replace(myText, ChrW(162), "&cent;")
  myText = Replace(myText, ChrW(163), "&pound;")
  myText = Replace(myText, ChrW(164), "&curren;")
  myText = Replace(myText, ChrW(165), "&yen;")
  myText = Replace(myText, ChrW(166), "&brvbar;")
  Rem
  Rem
  myText = Replace(myText, ChrW(169), "&copy;")
  myText = Replace(myText, ChrW(170), "&ordf;")
  myText = Replace(myText, ChrW(171), "&laquo;")
  myText = Replace(myText, ChrW(172), "&not;")
  myText = Replace(myText, ChrW(173), "&shy;")
  myText = Replace(myText, ChrW(174), "&reg;")
  myText = Replace(myText, ChrW(175), "&macr;")
  Rem
  Rem
  myText = Replace(myText, ChrW(178), "&sup2;")
  myText = Replace(myText, ChrW(179), "&sup3;")
  Rem
  myText = Replace(myText, ChrW(181), "&micro;")
  Rem
  myText = Replace(myText, ChrW(183), "&middot;")
  myText = Replace(myText, ChrW(184), "&cedil;")
  myText = Replace(myText, ChrW(185), "&sup1;")
  myText = Replace(myText, ChrW(186), "&ordm;")
  myText = Replace(myText, ChrW(187), "&raquo;")
  myText = Replace(myText, ChrW(188), "&frac14;")
  myText = Replace(myText, ChrW(189), "&frac12;")
  myText = Replace(myText, ChrW(190), "&frac34;")
  myText = Replace(myText, ChrW(191), "&iquest;")
  myText = Replace(myText, ChrW(192), "&Agrave;")
  myText = Replace(myText, ChrW(193), "&Aacute;")
  myText = Replace(myText, ChrW(194), "&Acirc;")
  myText = Replace(myText, ChrW(195), "&Atilde;")
  myText = Replace(myText, ChrW(196), "&Auml;")
  myText = Replace(myText, ChrW(197), "&Aring;")
  myText = Replace(myText, ChrW(198), "&AElig;")
  myText = Replace(myText, ChrW(199), "&Ccedil;")
  myText = Replace(myText, ChrW(200), "&Egrave;")
  myText = Replace(myText, ChrW(201), "&Eacute;")
  myText = Replace(myText, ChrW(202), "&Ecirc;")
  myText = Replace(myText, ChrW(203), "&Euml;")
  myText = Replace(myText, ChrW(204), "&Igrave;")
  myText = Replace(myText, ChrW(205), "&Iacute;")
  myText = Replace(myText, ChrW(206), "&Icirc;")
  myText = Replace(myText, ChrW(207), "&Iuml;")
  myText = Replace(myText, ChrW(208), "&ETH;")
  myText = Replace(myText, ChrW(209), "&Ntilde;")
  myText = Replace(myText, ChrW(210), "&Ograve;")
  myText = Replace(myText, ChrW(211), "&Oacute;")
  myText = Replace(myText, ChrW(212), "&Ocirc;")
  myText = Replace(myText, ChrW(213), "&Otilde;")
  myText = Replace(myText, ChrW(214), "&Ouml;")
  Rem
  myText = Replace(myText, ChrW(216), "&Oslash;")
  myText = Replace(myText, ChrW(217), "&Ugrave;")
  myText = Replace(myText, ChrW(218), "&Uacute;")
  myText = Replace(myText, ChrW(219), "&Ucirc;")
  myText = Replace(myText, ChrW(220), "&Uuml;")
  myText = Replace(myText, ChrW(221), "&Yacute;")
  myText = Replace(myText, ChrW(222), "&THORN;")
  myText = Replace(myText, ChrW(223), "&szlig;")
  myText = Replace(myText, ChrW(224), "&agrave;")
  myText = Replace(myText, ChrW(225), "&aacute;")
  myText = Replace(myText, ChrW(226), "&acirc;")
  myText = Replace(myText, ChrW(227), "&atilde;")
  myText = Replace(myText, ChrW(228), "&auml;")
  myText = Replace(myText, ChrW(229), "&aring;")
  myText = Replace(myText, ChrW(230), "&aelig;")
  myText = Replace(myText, ChrW(231), "&ccedil;")
  myText = Replace(myText, ChrW(232), "&egrave;")
  myText = Replace(myText, ChrW(233), "&eacute;")
  myText = Replace(myText, ChrW(234), "&ecirc;")
  myText = Replace(myText, ChrW(235), "&euml;")
  myText = Replace(myText, ChrW(236), "&igrave;")
  myText = Replace(myText, ChrW(237), "&iacute;")
  myText = Replace(myText, ChrW(238), "&icirc;")
  myText = Replace(myText, ChrW(239), "&iuml;")
  myText = Replace(myText, ChrW(240), "&eth;")
  myText = Replace(myText, ChrW(241), "&ntilde;")
  myText = Replace(myText, ChrW(242), "&ograve;")
  myText = Replace(myText, ChrW(243), "&oacute;")
  myText = Replace(myText, ChrW(244), "&ocirc;")
  myText = Replace(myText, ChrW(245), "&otilde;")
  myText = Replace(myText, ChrW(246), "&ouml;")
  Rem
  myText = Replace(myText, ChrW(248), "&oslash;")
  myText = Replace(myText, ChrW(249), "&ugrave;")
  myText = Replace(myText, ChrW(250), "&uacute;")
  myText = Replace(myText, ChrW(251), "&ucirc;")
  myText = Replace(myText, ChrW(252), "&uuml;")
  myText = Replace(myText, ChrW(253), "&yacute;")
  myText = Replace(myText, ChrW(254), "&thorn;")
  myText = Replace(myText, ChrW(255), "&yuml;")
  '
  For i = 256 To 511
    myText = Replace(myText, ChrW(i), "&#" & i & ";")
  Next ' i
End Sub ' EspizoRvOthers *----*----*    *----*----*    *----*----*    *----*----*