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

Sub EspVortizo()
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem エスペラント語 代用文字 範囲内 置換処理／PEJVO 辞書ファイル 照会処理
  Rem （コロン区切り形式ファイル SQL文指定 データ参照処理）
  Rem 作譜：Hitrock Camellia Shinopy
  Rem 言語：Word VBA
  Rem 機能...
  Rem   1. エスペラント語代用文字を正書文字に置換する。
  Rem   2. エスペラント語正書文字を代用文字に置換する。
  Rem   3. 範囲選択した文字列で辞書ファイルの単語・訳語を検索する。
  Rem   4. 検索した文字列に該当する単語・訳語を文書上に書き出しする。
  Rem 注記...
  Rem   1.「EspVortizo」を起動して、ツールバーを追加し、コマンドボタンを押して、処理を実行する｡
  Rem   2. [エスペラント語 代用文字 範囲内 置換処理]に不具合あり。
  Rem        EspizoSuff実行後に、カーソル位置が選択範囲の末尾より1〜2文字分左になることがある。
  Rem   3. コロン区切り形式ファイルを参照する部分を、下記の書籍から引用して、Word VBA用に改変した。
  Rem      小島政行『VisualBasic,VBA,VBScriptのための実践＆リファレンスADO』アプライドナレッジの
  Rem        「第3部 ADOの活用  第2章 VBA」
  Rem    　佐藤信正『VBScript実用プログラミング・テクニック』メディア・テック出版の
  Rem        「Part5 [16]12万件の郵便番号を検索する」
  Rem   4. 「DBPath」にコロン区切り形式ファイルの保存先フォルダを指定すること。
  Rem      （既定値は「EspRevizo」の「pejvo-s.txt」ファイルの保存先）
  Rem   5. SQL文使用には、ファイル名にハイフンが使えないため、（已むを得ず）
  Rem      「pejvo-s.txt」ファイルをコピーし、ファイル名のハイフンをアンダーバーに変更してから、
  Rem      このマクロを実行すること。「pejvo-s.txt」→「pejvo_s.txt」
  Rem   6. 初回実行前に、コロン区切り形式ファイルの保存先フォルダに「schema.ini」ファイルを作成しておくこと。
  Rem      （「EspVortizoSchemaIni」を初回実行前に先行して、一度だけ実行する。）
  Rem   7. このマクロの一部に下記の「Espizo」「EspRevizo」のプロシージャを使用している。
  Rem      EspizoAeiou・EspizoCghjsu・EspizoOthers・
  Rem      EspizoRvAeiou・EspizoRvCghjsu・EspizoRvOthers・
  Rem      EspRevizoConst
  Rem   8. Win32 APIを利用：GetAsyncKeyState関数。
  Rem   不具合あり。
  Rem     1. EspizoSuff実行後に、カーソル位置が選択範囲の末尾より1〜2文字分左になることがある。
  Rem     2. 文章が頁を跨いだ場合、文章入力時に画面が上下してチラつきが発生する。
  Rem       「.」で文章を区切るか、スクロールバーを上下させて表示位置を変えるなどの対処が必要。
  Rem 履歴...
  Rem   第01版：2007/10/04：作成。
  Rem   第02版：2007/11/13：[選択して下さい。]ボタン処理を追加。
  Rem   第03版：2008/01/03：[IEに表示する]ボタン処理を追加。
  Rem   第04版：2008/05/20：Espizoの機能を追加。
  Rem   第05版：2008/08/28：FaceIdを変更。（1611=>1063 252=>284）
  Rem   第06版：2008/09/20：[あいまい検索設定]ボタンを追加。
  Rem   第07版：2008/11/01...
  Rem     [PEJVO 辞書ファイル 照会処理を実行！]時に、字上符のない単語を検索する際に、
  Rem     字上符の付いた単語を表示しないように変更。
  Rem   第08版：2008/12/01...
  Rem     当マクロの一部の機能を、Windows音声認識で起動できるようにするため、
  Rem     ツールバーのCaptionプロパティ指定を変更。
  Rem   第09版：2009/04/01...
  Rem     打鍵起動処理を追加。[Space]キーを押すと、
  Rem     カーソルより前の一つの文章にある代用文字を正書文字に置換する。
  Rem     [^x記法]時には[X]キーを押すと、即時に置換する。
  Rem   第10版：2009/05/05：EspizoAutoLoopプロシージャのSelect Case文にDoEventsを追加。
  Rem   第11版：2009/05/10：打鍵起動処理の内、[Space]キーでの処理を[Pause]キーで処理するよう変更。
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem 参照設定する場合...
  Rem   Microsoft ActiveX Data Objects 2.8 Library
  Rem   Microsoft Internet Controls
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Dim myTitle As String
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Rem 既定値の設定
  myTitle = "EspVortizo"
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Rem ステータスバーの表示
  Application.DisplayStatusBar = True
  '
  Call EspVortizoBlln(myTitle)
End Sub ' EspVortizo *----*----*    *----*----*    *----*----*    *----*----*

Sub EspVortizoBlln(myTitle As String)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem ツールバー表示処理
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Dim myCmmdBar As CommandBar
  Dim myAutoEspizo As CommandBarControl
  Dim myBttnEspizo As CommandBarControl
  Dim myCkboxEspizo As CommandBarControl
  Dim myBttnMatchFuzzy As CommandBarControl
  Dim myBttnVortizo As CommandBarControl
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Rem 同名ツールバーの削除
  On Error Resume Next
  CommandBars(myTitle).Delete
  On Error GoTo 0
  '
  Set myCmmdBar = CommandBars.Add(Name:=myTitle, Position:=msoBarTop, Temporary:=True)
  Set myAutoEspizo = myCmmdBar.Controls.Add(Type:=msoControlButton, Before:=1, Temporary:=True)
  Set myBttnEspizo = myCmmdBar.Controls.Add(Type:=msoControlButton, Before:=2, Temporary:=True)
  Set myCkboxEspizo = myCmmdBar.Controls.Add(Type:=msoControlDropdown, Before:=3, Temporary:=True)
  ' Set myCkboxEspizo = myCmmdBar.Controls.Add(Type:=msoControlComboBox, Before:=3, Temporary:=True)
  Set myBttnMatchFuzzy = myCmmdBar.Controls.Add(Type:=msoControlButton, Before:=4, Temporary:=True)
  Set myBttnVortizo = myCmmdBar.Controls.Add(Type:=msoControlButton, Before:=5, Temporary:=True)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  With myAutoEspizo
    .DescriptionText = "エスペラント語 代用文字 範囲内置換：選択した処理をキーを押して起動します。"
    .Style = msoButtonIcon
    .Caption = "エス文字 文字列の置き換え 打鍵起動"
    .TooltipText = "[ 文字列の置き換え打鍵起動！]"
    .FaceId = 6917
    .OnAction = myTitle & "AutoEspizo"
  End With
  '
  With myBttnEspizo
    .DescriptionText = "エスペラント語 代用文字 範囲内 置換処理：選択した処理を実行します。"
    .Style = msoButtonIcon
    .Caption = "エス文字 文字列の置き換え"
    .TooltipText = "[ 文字列の置き換え実行！]" ' "代用文字 範囲内 置換処理を実行！"
    .FaceId = 1063
    .OnAction = myTitle & "BttnEspizo"
  End With
  '
  With myCkboxEspizo
    .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 = myTitle & "CkboxEspizo"
  End With
  '
  With myBttnMatchFuzzy
    .DescriptionText = "PEJVO 辞書ファイル 照会処理：[あいまい検索設定]ボタン"
    .BeginGroup = True
    .Style = msoButtonIcon
    .Caption = "検索方法の指定"
    .TooltipText = "単語と訳語を 前後あいまい検索します。"
    .FaceId = 2525
    .OnAction = myTitle & "BttnMatchFuzzy"
    .Parameter = ""
  End With
  '
  With myBttnVortizo
    .DescriptionText = "PEJVO 辞書ファイル 照会処理：処理を実行します。"
    .BeginGroup = True
    .Style = msoButtonIcon
    .Caption = "字引き 辞書の照会"
    .TooltipText = "[ 辞書の照会！ ]" ' "PEJVO 辞書ファイル 照会処理を実行！"
    .FaceId = 353 ' 284
    .OnAction = myTitle & "BttnVortizo"
    .Parameter = "0,1,2,3,4,289"
  End With
  '
  myCmmdBar.Visible = True
End Sub ' EspVortizoBlln *----*----*    *----*----*    *----*----*    *----*----*

Sub EspVortizoCkboxEspizo(Optional myDummy As Boolean)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem [処理]コンボボックス処理
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  With CommandBars("EspVortizo").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 ' EspVortizoCkboxEspizo *----*----*    *----*----*    *----*----*    *----*----*

Sub EspVortizoAutoEspizo(Optional myDummy As Boolean)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem 自動実行ボタン処理
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  With CommandBars("EspVortizo").Controls(1)
    If .FaceId = 6917 Then
      .FaceId = 6914
      .TooltipText = "打鍵起動 処理中。 実行:[x]/[Pause]キー  終了:[Esc]キー"
      Call EspVortizoAutoLoop("EspVortizo")
    Else
      .FaceId = 6917
      .TooltipText = "[ 文字列の置き換え打鍵起動！]"
    End If
  End With
End Sub ' EspVortizoAutoEspizo *----*----*    *----*----*    *----*----*    *----*----*

Sub EspVortizoBttnEspizo(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 = "EspVortizo"
  '
  With CommandBars(myTitle).Controls(3)
    myLabel = .Text
    myBttn = .ListIndex
  End With
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Select Case myBttn
    Case 0, 6, 10
      GoTo EspVortizoBttnEspizoSubExit
  End Select
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Application.ScreenUpdating = False
  '
  If Selection.Range.Text = "" Then
    c = Selection.MoveUp(wdParagraph, 1, wdExtend)
    If c = 0 Then
      GoTo EspVortizoBttnEspizoSubExit
    End If
  End If
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
EspVortizoBttnEspizoSubEntry:
  Select Case myBttn
    Case 1
      Call EspVortizoSffx("x")
    Case 2
      Call EspVortizoSffx("^")
    Case 3
      Call EspVortizoUcs2
    Case 4
      Call EspVortizoSffx("'")
    Case 5
      Call EspVortizoSffx("h")
    Case 7
      Call EspVortizoSuff("x")
    Case 8
      Call EspVortizoSuff("^")
    Case 9
      Call EspVortizoSuff("")
    Case 11
      Call EspVortizoPrfx("^") ' ^接頭字記法
  End Select
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
EspVortizoBttnEspizoSubExit:
  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 ' EspVortizoBttnEspizo *----*----*    *----*----*    *----*----*    *----*----*

Sub EspVortizoAutoLoop(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 EspVortizoBttnEspizo
          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 EspVortizoBttnEspizo
        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 ' EspVortizoAutoLoop *----*----*    *----*----*    *----*----*    *----*----*

Sub EspVortizoSffx(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
  '
EspVortizoSffxSubEntry:
  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 EspVortizoSffxSubExit
  '
  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 = "EspVortizo" & "：処理中" & " " & Format(C, "##0") & "%"
    Next ' i
  End With
  '
EspVortizoSffxSubExit:
  myRange.Select ' 当初の選択範囲。
  Selection.Collapse wdCollapseEnd
  '
  Set myRegExp = Nothing
  Set myMatches = Nothing
  '
  Set myRange = Nothing
  Set myChrsFound = Nothing
End Sub ' EspVortizoSffx *----*----*    *----*----*    *----*----*    *----*----*

Sub EspVortizoUcs2(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
  '
EspVortizoUcs2SubEntry:
  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 EspVortizoUcs2SubExit
  '
  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 = "EspVortizo" & "：処理中" & " " & Format(C, "##0") & "%"
    Next ' i
  End With
  '
EspVortizoUcs2SubExit:
  myRange.Select ' 当初の選択範囲。
  Selection.Collapse wdCollapseEnd
  '
  Set myRegExp = Nothing
  Set myMatches = Nothing
  '
  Set myRange = Nothing
  Set myChrsFound = Nothing
End Sub ' EspVortizoUcs2 *----*----*    *----*----*    *----*----*    *----*----*

Sub EspVortizoSuff(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 = "EspVortizo" & "：処理中" & " " & 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 ' EspVortizoSuff *----*----*    *----*----*    *----*----*    *----*----*

Sub EspVortizoPrfx(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
  '
EspVortizoPrfxSubEntry:
  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 EspVortizoPrfxSubExit
  '
  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 = "EspVortizo" & "：処理中" & " " & Format(C, "##0") & "%"
    Next ' i
  End With
  '
EspVortizoPrfxSubExit:
  myRange.Select ' 当初の選択範囲。
  Selection.Collapse wdCollapseEnd
  '
  Set myRegExp = Nothing
  Set myMatches = Nothing
  '
  Set myRange = Nothing
  Set myChrsFound = Nothing
End Sub ' EspVortizoPrfx *----*----*    *----*----*    *----*----*    *----*----*

Sub EspVortizoBttnMatchFuzzy(Optional myDummy As Boolean)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem [あいまい検索設定]ボタン処理
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Dim myTitle As String
  Dim myParameter As Variant
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  myTitle = "EspVortizo"
  With CommandBars(myTitle).Controls(4)
    Select Case .FaceId
       Case 2525
         .FaceId = 2526
         .TooltipText = "単語を 前方一致で 検索します。"
       Case 2526
         .FaceId = 2527
         .TooltipText = "単語を 後方一致で 検索します。"
       Case 2527
        .FaceId = 2525
        .TooltipText = "単語と訳語を 前後あいまい検索します。"
    End Select
  End With
End Sub ' EspVortizoBttnMatchFuzzy *----*----*    *----*----*    *----*----*    *----*----*

Sub EspVortizoBttnVortizo(Optional myDummy As Boolean)
  Dim myConn As Variant ' ADODB.Connection
  Dim myRecSet As Variant ' ADODB.Recordset
  Dim DBPath As String
  Dim CsvDB As String
  Dim myDicPcase As String
  Dim myDicLcase As String
  Dim mySQL As String
  '
  Dim myTitle As String
  Dim myFlag As Boolean
  Dim i As Long
  Dim j As Long
  Dim myStatusBar As String
  '
  Dim myRange As Range
  Dim myText As String
  Dim myFindSurrogate As String
  Dim myFindOrtho As String
  Dim myItem As String
  Dim myItemColumn As String
  Dim myWord As String
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Rem 既定値の設定
  myTitle = "EspVortizo"
  Call EspRevizoConst("myFolder", DBPath)
  Call EspRevizoConst("myDicPejvo", CsvDB)
  Call EspRevizoConst("myDicPcase", myDicPcase)
  Call EspRevizoConst("myDicLcase", myDicLcase)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Set myRange = Selection.Range
  myText = Selection.Range.Text
  Call EspVortizoDelString(myText)
  myFindOrtho = Trim(myText)
  myFindSurrogate = myFindOrtho
  Call EspizoRvAeiou("", "_", myFindSurrogate)
  Call EspizoRvCghjsu("", "^", myFindSurrogate)
  Call EspizoRvOthers(myFindSurrogate)
  myFindSurrogate = Replace(myFindSurrogate, "^", "[^]")
  myFindSurrogate = Replace(myFindSurrogate, "_", "[_]")
  '
  If myText = "" Then Exit Sub
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Rem 新規オブジェクトをセット
  Set myConn = CreateObject("ADODB.Connection")
  Set myRecSet = CreateObject("ADODB.Recordset")
  '
  Rem 「Extended Properties=TEXT;」を指定してCSVファイルに接続
  myConn.Open _
    "Provider=Microsoft.Jet.OLEDB.4.0;" & _
    "Data Source=" & DBPath & ";" & _
    "Extended Properties=TEXT;"
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
EspVortizoBttnSubEntry:
  With CommandBars(myTitle).Controls(4)
    Select Case .FaceId
      Case 2525
        Rem 単語と訳語を 前後あいまい検索します。
        mySQL = "Select  単語 & ' : ' & 訳語  From  " & CsvDB & "  "
        mySQL = mySQL & "Where 単語 Like '%" & myFindSurrogate & "%'  "
        mySQL = mySQL & "Or 訳語 Like '%" & myFindSurrogate & "%'  "
        mySQL = mySQL & "  Union All  "
        mySQL = mySQL & "Select  単語 & ' : ' & 訳語  From  " & myDicPcase & "  "
        mySQL = mySQL & "Where 単語 Like '%" & myFindSurrogate & "%'  "
        mySQL = mySQL & "Or 訳語 Like '%" & myFindSurrogate & "%'  "
        mySQL = mySQL & "  Union All  "
        mySQL = mySQL & "Select  単語 & ' : ' & 訳語  From  " & myDicLcase & "  "
        mySQL = mySQL & "Where 単語 Like '%" & myFindSurrogate & "%'  "
        mySQL = mySQL & "Or 訳語 Like '%" & myFindSurrogate & "%';  "
      Case 2526
        Rem 単語を 前方一致で 検索します。
        mySQL = "Select  単語 & ' : ' & 訳語  From  " & CsvDB & "  "
        mySQL = mySQL & "Where 単語 Like '" & myFindSurrogate & "%'  "
        mySQL = mySQL & "  Union All  "
        mySQL = mySQL & "Select  単語 & ' : ' & 訳語  From  " & myDicPcase & "  "
        mySQL = mySQL & "Where 単語 Like '" & myFindSurrogate & "%'  "
        mySQL = mySQL & "  Union All  "
        mySQL = mySQL & "Select  単語 & ' : ' & 訳語  From  " & myDicLcase & "  "
        mySQL = mySQL & "Where 単語 Like '" & myFindSurrogate & "%';  "
      Case 2527
        Rem 単語を 後方一致で 検索します。
        mySQL = "Select  単語 & ' : ' & 訳語  From  " & CsvDB & "  "
        mySQL = mySQL & "Where 単語 Like '%" & myFindSurrogate & "'  "
        mySQL = mySQL & "  Union All  "
        mySQL = mySQL & "Select  単語 & ' : ' & 訳語  From  " & myDicPcase & "  "
        mySQL = mySQL & "Where 単語 Like '%" & myFindSurrogate & "'  "
        mySQL = mySQL & "  Union All  "
        mySQL = mySQL & "Select  単語 & ' : ' & 訳語  From  " & myDicLcase & "  "
        mySQL = mySQL & "Where 単語 Like '%" & myFindSurrogate & "';  "
    End Select
  End With
  '
  Rem テーブルへの参照を取得
  With myRecSet
    .ActiveConnection = myConn
    .Source = mySQL
    .Open
  End With
  '
  Call EspVortizoCmmdBar(myTitle & "Bttn")
  '
  Rem フィールド名を転記
  'For i = 1 To myRecSet.Fields.Count
  '  Selection.TypeText Text:=myRecSet.Fields(i - 1).Name & " "
  'Next ' i
  '
  j = 0
  Rem レコードを転記
  Do While Not myRecSet.EOF
    myItem = ""
    For i = 1 To myRecSet.Fields.Count
      myItemColumn = myRecSet.Fields(i - 1).Value ' & vbCr
      Call EspizoAeiou("", "_", myItemColumn)
      Call EspizoCghjsu("", "^", myItemColumn)
      Call EspizoUcOthers(myItemColumn)
      myItem = myItem & myItemColumn
    Next ' i
    '
    myFlag = False
    With CommandBars(myTitle).Controls(4)
      Select Case .FaceId
        Case 2525
          Rem 単語と訳語を 前後あいまい検索します。
          If InStr(myItem, myFindOrtho) > 0 Then
            myFlag = True
          End If
        Case 2526
          Rem 単語を 前方一致で 検索します。
          myWord = Left(myItem, InStr(myItem, " : ") - 1)
          If Left(myWord, Len(myFindOrtho)) = myFindOrtho Then
            myFlag = True
          End If
        Case 2527
          Rem 単語を 後方一致で 検索します。
          myWord = Left(myItem, InStr(myItem, " : ") - 1)
          If Right(myWord, Len(myFindOrtho)) = myFindOrtho Then
            myFlag = True
          End If
      End Select
    End With
    '
    If myFlag = True Then
      j = j + 1
      With CommandBars(myTitle & "Bttn").Controls(2)
        .AddItem myItem, j
        .DropDownLines = j
        .ListIndex = 1
      End With
    End If
    '
    myRecSet.MoveNext
  Loop
  '
  Beep
  Call EspVortizoPopUp(myTitle & "Bttn", j, myFindOrtho)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
EspVortizoBttnSubExit:
  Rem 接続を閉じる
  On Error Resume Next
  myRecSet.Close
  myConn.Close
  CommandBars(myTitle & "Bttn").Delete
  On Error GoTo 0
  Set myRange = Nothing
  Set myConn = Nothing
  Set myRecSet = Nothing
End Sub ' EspVortizoBttnVortizo *----*----*    *----*----*    *----*----*    *----*----*

Sub EspVortizoDelString(myText As String)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem 不要文字列除外処理
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  myText = Replace(myText, vbTab, "")
  myText = Replace(myText, vbCrLf, "")
  myText = Replace(myText, vbVerticalTab, "")
  myText = Replace(myText, vbCr, "")
  myText = Replace(myText, vbLf, "")
  myText = Replace(myText, " ", "")
  myText = Replace(myText, "　", "")
End Sub ' EspVortizoDelString *----*----*    *----*----*    *----*----*    *----*----*

Sub EspVortizoPopUp(myTitle As String, j As Long, myFind As String)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem リストボックス表示処理
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Dim myMsg As String
  Dim myText As String
  Dim myStatusBar As String
  Dim i As Long
  Dim x As Long
  Dim y As Long
  Dim myFaceId As Long
  '
  Dim myIE As Variant ' InternetExplorer
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  If j <= 0 Then
    Selection.Collapse wdCollapseStart
    myStatusBar = "該当するデータは、ありません。"
    Application.StatusBar = Replace(myTitle, "Bttn", "") & "：" & myStatusBar
    Exit Sub
  End If
  '
  myStatusBar = "該当するデータが、" & j & "件ありました。"
  Application.StatusBar = Replace(myTitle, "Bttn", "") & "：" & myStatusBar
  '
  myMsg = "該当するデータが、" & vbCrLf & j & "件ありました。"
  myMsg = myMsg & vbCrLf & vbCrLf
  myMsg = myMsg & "リストボックスから"
  myMsg = myMsg & "選択して下さい。" & Space(10)
  CommandBars(myTitle).Controls(1).Caption = myMsg
  x = -1: y = -1
  myFaceId = CommandBars(myTitle).Controls(1).FaceId
  Do
    On Error Resume Next
    If x = -1 Then
      CommandBars(myTitle).ShowPopup
    Else
      CommandBars(myTitle).ShowPopup x, y
    End If
    On Error GoTo 0
    DoEvents
    Select Case CommandBars(myTitle).Controls(1).FaceId
      Case 459, 64, 330, 1445 ' リストボックス選択／キャンセル／全部書き出す／IEに表示する
        Exit Do
      Case 289, 219, 288, 487 ' [書き出す内容]／[選択して下さい。]
        x = CommandBars(myTitle).Left
        y = CommandBars(myTitle).Top
        CommandBars(myTitle).Controls(1).FaceId = myFaceId
      Case Else
        x = -1: y = -1
    End Select
  Loop
  '
  Select Case CommandBars(myTitle).Controls(1).FaceId
    Case 330 ' [キャンセル]
      Selection.Collapse wdCollapseStart
      Exit Sub
    Case 459 ' リストボックス選択
      Selection.Collapse wdCollapseEnd
      myText = CommandBars(myTitle).Controls(2).Text
      Call EspVortizoSelText(myTitle, myText)
      Selection.TypeText myText
    Case 64 ' [全部書き出す]
      Selection.Collapse wdCollapseEnd
      For i = 1 To j
        With CommandBars(myTitle).Controls(2)
          .ListIndex = i
          myText = .Text
          Call EspVortizoSelText(myTitle, myText)
        End With
        Selection.TypeText myText & vbCrLf
        myStatusBar = "文書上に、単語と訳語を書き出し中です。" & " " & i & "/" & j & "件"
        Application.StatusBar = Replace(myTitle, "Bttn", "") & "：" & myStatusBar
      Next ' i
      Selection.TypeBackspace
    Case 1445 ' [IEに表示する]
      Set myIE = CreateObject("InternetExplorer.Application")
      '
      With myIE
        .Navigate "about:blank"
        .Visible = True
        Do While .Busy
          DoEvents
        Loop
        DoEvents
      End With
      '
      myIE.Document.write "<!-- saved from url=(0014)about:internet -->" & vbCrLf
      myIE.Document.write "<title>EspVortizo: " & myFind & "</title>" & vbCrLf
      For i = 1 To j
        With CommandBars(myTitle).Controls(2)
          .ListIndex = i
          myText = .Text
          Call EspVortizoSelText(myTitle, myText)
        End With
        myIE.Document.write myText & "<br>" & vbCrLf
        myStatusBar = "文書上に、単語と訳語を書き出し中です。" & " " & i & "/" & j & "件"
        Application.StatusBar = Replace(myTitle, "Bttn", "") & "：" & myStatusBar
      Next ' i
  End Select
  '
  Beep
  myStatusBar = "文書上に、単語と訳語を書き出しました。"
  Application.StatusBar = Replace(myTitle, "Bttn", "") & "：" & myStatusBar
End Sub ' EspVortizoPopUp *----*----*    *----*----*    *----*----*    *----*----*

Sub EspVortizoSelText(myTitle As String, myText As String)
  Select Case CommandBars(myTitle).Controls(5).FaceId
     Case 289
       Rem .TooltipText = "単語と訳語の両方を書き出します。"
     Case 219
       Rem .TooltipText = "単語を書き出します。"
       myText = Left(myText, InStr(myText, " : ") - 1)
     Case 288
       Rem .TooltipText = "訳語を書き出します。"
       myText = Mid(myText, InStr(myText, " : ") + 3)
  End Select
End Sub ' EspVortizoSelText *----*----*    *----*----*    *----*----*    *----*----*

Sub EspVortizoCmmdBar(myTitle As String)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem ポップアップメニュー設定処理
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Dim myCmmdBar As CommandBar
  Dim myCtrlIcon As CommandBarControl
  Dim myCtrlDdwn As CommandBarControl
  Dim myCtrlAll As CommandBarControl
  Dim myCtrlCancel As CommandBarControl
  Dim myCtrlWdwn As CommandBarControl
  Dim myCtrlIeDoc As CommandBarControl
  '
  Dim myParameter As Variant
  Dim myText As String
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  On Error Resume Next
  CommandBars(myTitle).Delete
  On Error GoTo 0
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Set myCmmdBar = CommandBars.Add(Name:=myTitle, Position:=msoBarPopup, Temporary:=True)
  Set myCtrlIcon = myCmmdBar.Controls.Add(Type:=msoControlButton, Before:=1, Temporary:=True)
  Set myCtrlDdwn = myCmmdBar.Controls.Add(Type:=msoControlDropdown, Before:=2, Temporary:=True)
  Set myCtrlAll = myCmmdBar.Controls.Add(Type:=msoControlButton, Before:=3, Temporary:=True)
  Set myCtrlIeDoc = myCmmdBar.Controls.Add(Type:=msoControlButton, Before:=4, Temporary:=True)
  Set myCtrlWdwn = myCmmdBar.Controls.Add(Type:=msoControlButton, Before:=5, Temporary:=True)
  Set myCtrlCancel = myCmmdBar.Controls.Add(Type:=msoControlButton, Before:=6, Temporary:=True)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  With myCtrlIcon
    .DescriptionText = "PEJVO辞書ファイル訳語問い合わせ処理"
    .Style = msoButtonIconAndWrapCaption
    .Caption = "選択して下さい。"
    .TooltipText = "該当するデータを選択して下さい。"
    .FaceId = 1089
    .OnAction = myTitle & "Icon"
  End With
  '
  With myCtrlDdwn
    .DescriptionText = "PEJVO辞書ファイルのデータをリストボックスから選択させます。"
    .Style = msoComboNormal ' msoComboLabel
    .Caption = "" ' "項目："
    .TooltipText = "該当する項目を選んで下さい。"
    .BeginGroup = True
    ' .DropDownLines = 0
    .DropDownWidth = 600
    .OnAction = myTitle & "Ddwn"
  End With
  '
  With myCtrlAll
    .DescriptionText = "[全件書き出す]ボタン"
    .Style = msoButtonIconAndCaption
    .Caption = "全件書き出す" & String(24, "　")
    .TooltipText = "検索した内容を全件書き出します。"
    .BeginGroup = True
    .FaceId = 64
    .OnAction = myTitle & "All"
  End With
  '
  With myCtrlIeDoc
    .DescriptionText = "[IEに表示する]ボタン"
    .Style = msoButtonIconAndCaption
    .Caption = "IEに表示する" & String(24, "　")
    .TooltipText = "検索した内容をIEに表示します。"
    .BeginGroup = True
    .FaceId = 1445
    .OnAction = myTitle & "IeDoc"
  End With
  '
  With myCtrlWdwn
    .DescriptionText = "[書き出す内容]ボタン"
    .Style = msoButtonIconAndCaption
    .BeginGroup = True
    .OnAction = myTitle & "Wdwn"
    myParameter = Split(CommandBars(Replace(myTitle, "Bttn", "")).Controls(5).Parameter, ",")
    Select Case myParameter(5)
       Case 289
         .FaceId = 289
         .Caption = "単語：訳語" & String(24, "　")
         .TooltipText = "単語と訳語の両方を書き出します。"
       Case 219
         .FaceId = 219
         .Caption = "単語" & String(24, "　")
         .TooltipText = "単語を書き出します。"
       Case 288
         .FaceId = 288
         .Caption = "訳語" & String(24, "　")
         .TooltipText = "訳語を書き出します。"
    End Select
  End With
  '
  With myCtrlCancel
    .DescriptionText = "[キャンセル]ボタン"
    .Style = msoButtonIconAndCaption
    .Caption = "キャンセル" & String(24, "　")
    .TooltipText = "処理を中止します。"
    .BeginGroup = True
    .FaceId = 330
    .OnAction = myTitle & "Cancel"
  End With
End Sub ' EspVortizoCmmdBar *----*----*    *----*----*    *----*----*    *----*----*

Sub EspVortizoBttnIcon(Optional myDummy As Boolean)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem [選択して下さい。]ボタン処理
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Dim myTitle As String
  '
  myTitle = "EspVortizoBttn"
  CommandBars(myTitle).Controls(1).FaceId = 487
End Sub ' EspVortizoBttnIcon *----*----*    *----*----*    *----*----*    *----*----*

Sub EspVortizoBttnDdwn(Optional myDummy As Boolean)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem リストボックス選択処理
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Dim myTitle As String
  '
  myTitle = "EspVortizoBttn"
  CommandBars(myTitle).Controls(1).FaceId = 459
End Sub ' EspVortizoBttnDdwn *----*----*    *----*----*    *----*----*    *----*----*

Sub EspVortizoBttnAll(Optional myDummy As Boolean)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem [全件書き出す]ボタン処理
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Dim myTitle As String
  '
  myTitle = "EspVortizoBttn"
  CommandBars(myTitle).Controls(1).FaceId = 64
End Sub ' EspVortizoBttnAll *----*----*    *----*----*    *----*----*    *----*----*

Sub EspVortizoBttnIeDoc(Optional myDummy As Boolean)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem [IEに表示する]ボタン処理
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Dim myTitle As String
  '
  myTitle = "EspVortizoBttn"
  CommandBars(myTitle).Controls(1).FaceId = 1445
End Sub ' EspVortizoBttnIeDoc *----*----*    *----*----*    *----*----*    *----*----*

Sub EspVortizoBttnWdwn(Optional myDummy As Boolean)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem [書き出す内容]ボタン処理
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Dim myTitle As String
  Dim myParameter As Variant
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  myTitle = "EspVortizoBttn"
  With CommandBars(myTitle).Controls(5)
    Select Case .FaceId
       Case 289
         .FaceId = 219
         .Caption = "単語" & String(24, "　")
         .TooltipText = "単語を書き出します。"
       Case 219
         .FaceId = 288
         .Caption = "訳語" & String(24, "　")
         .TooltipText = "訳語を書き出します。"
       Case 288
        .FaceId = 289
        .Caption = "単語：訳語" & String(24, "　")
        .TooltipText = "単語と訳語の両方を書き出します。"
    End Select
  End With
  CommandBars(myTitle).Controls(1).FaceId = CommandBars(myTitle).Controls(5).FaceId
  myParameter = Split(CommandBars(Replace(myTitle, "Bttn", "")).Controls(5).Parameter, ",")
  myParameter(5) = CommandBars(myTitle).Controls(5).FaceId
  CommandBars(Replace(myTitle, "Bttn", "")).Controls(5).Parameter = Join(myParameter, ",")
End Sub ' EspVortizoBttnWdwn *----*----*    *----*----*    *----*----*    *----*----*

Sub EspVortizoBttnCancel(Optional myDummy As Boolean)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem [キャンセル]ボタン処理
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Dim myTitle As String
  '
  myTitle = "EspVortizoBttn"
  CommandBars(myTitle).Controls(1).FaceId = 330
End Sub ' EspVortizoBttnCancel *----*----*    *----*----*    *----*----*    *----*----*

Sub EspVortizoSchemaIni() ' (Optional myDummy As Boolean)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem EspVortizo初期設定処理（「schema.ini」ファイルを作成）
  Rem （「EspVortizo」初回実行前に一度だけ実行）
  Rem 機能...
  Rem   1. EspVortizoの初期設定をする。
  Rem      見出し情報や内部構造をODBCに伝えるために、
  Rem      コロン区切り形式ファイルの保存先フォルダに「schema.ini」ファイルを作成する。
  Rem   2.「DBPath」にコロン区切り形式ファイルの保存先フォルダを指定すること。
  Rem      （既定値は「EspRevizo」の「pejvo-s.txt」ファイルの保存先）
  Rem   3.この処理で「schema.ini」ファイルを作成する。
  Rem 注記...
  Rem   1. コロン区切り形式ファイルを参照する部分を、下記の書籍から引用して、Word VBA用に改変した。
  Rem      佐藤信正『VBScript実用プログラミング・テクニック』メディア・テック出版の
  Rem        「Part5 [16]12万件の郵便番号を検索する」から引用した。
  Rem      結城圭介『最速攻略 VBScripサンプル大全集』技術評論社の
  Rem        「第3章 実践サンプル編 ファイル・フォルダ
  Rem          [3-13]フラットファイルのレイアウトを変更する
  Rem          [3-14]フラットファイルからCSVファイルを作成する」から引用した。
  Rem   2．「EspVortizo」初回実行前に先行して一度だけ実行すること。
  Rem   3. SQL文使用には、ファイル名にハイフンが使えないため、（已むを得ず）
  Rem      「pejvo-s.txt」ファイルをコピーし、ファイル名のハイフンをアンダーバーに変更する。
  Rem      「pejvo-s.txt」→「pejvo_s.txt」
  Rem   4. このマクロの一部に下記の「EspRevizo」のプロシージャを使用している。
  Rem      EspRevizoConst
  Rem 履歴...
  Rem   第01版：2007/10/04 作成。
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Dim myFso As Variant
  Dim myFile As Variant
  '
  Dim IniFile As String
  Dim myFullName As String
  '
  Dim DBPath As String
  Dim CsvDB As String
  Dim myDicPcase As String
  Dim myDicLcase As String
  '
  Dim myTitle As String
  Dim myStatusBar As String
  Dim myMsg As String
  Dim myAns As Long
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Rem 既定値の設定
  myTitle = "EspVortizoSchemaIni"
  Call EspRevizoConst("myFolder", DBPath)
  '
  CsvDB = "pejvo_s.txt" ' "pejvo-s.txt"
  Call EspRevizoConst("myDicPcase", myDicPcase)
  Call EspRevizoConst("myDicLcase", myDicLcase)
  '
  IniFile = "schema.ini"
  myFullName = DBPath & "\" & IniFile
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  myMsg = "[初期設定] " & vbCrLf & "処理を実行します。　" & vbCrLf & vbCrLf
  myMsg = myMsg & "処理を中止したい場合は、" & vbCrLf
  myMsg = myMsg & "[キャンセル]を選択して下さい。"
  myStatusBar = Replace(myMsg, vbCrLf, "")
  '
  Application.StatusBar = myTitle & "：" & myStatusBar
  myAns = MsgBox(myMsg, vbOKCancel + vbCritical + vbDefaultButton2, myTitle)
  '
  If myAns <> vbOK Then Exit Sub
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Set myFso = CreateObject("Scripting.FileSystemObject")
  '
  If myFso.FileExists(myFullName) = True Then
    myMsg = "[初期設定] " & vbCrLf & vbCrLf
    myMsg = myMsg & "既定のフォルダとファイルは、作成済みです。"
    MsgBox myMsg, vbOKOnly + vbCritical, myTitle
    Exit Sub
  End If
  '
  Rem 関連ファイルを作成する。
  Set myFile = myFso.CreateTextFile(myFullName)
  With myFile
    .WriteLine ("[" & CsvDB & "]")
    '
    .WriteLine ("ColNameHeader=False")
    .WriteLine ("CharacterSet=oem")
    .WriteLine ("Format=Delimited(:)")
    '
    .WriteLine ("Col1=単語 Char Width 255")
    .WriteLine ("Col2=訳語 Char Width 255")
    .WriteLine (vbCrLf)
    ' *----*----*    *----*----*
    .WriteLine ("[" & myDicLcase & "]")
    '
    .WriteLine ("ColNameHeader=False")
    .WriteLine ("CharacterSet=oem")
    .WriteLine ("Format=Delimited(:)")
    '
    .WriteLine ("Col1=単語 Char Width 255")
    .WriteLine ("Col2=訳語 Char Width 255")
    .WriteLine (vbCrLf)
    ' *----*----*    *----*----*
    .WriteLine ("[" & myDicPcase & "]")
    '
    .WriteLine ("ColNameHeader=False")
    .WriteLine ("CharacterSet=oem")
    .WriteLine ("Format=Delimited(:)")
    '
    .WriteLine ("Col1=単語 Char Width 255")
    .WriteLine ("Col2=訳語 Char Width 255")
    .Close
  End With
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  myMsg = "[初期設定] " & vbCrLf
  myMsg = myMsg & "処理が完了しました！" & vbCrLf
  myStatusBar = Replace(myMsg, vbCrLf, "")
  '
  Application.StatusBar = myTitle & "：" & myStatusBar
  myAns = MsgBox(myMsg, vbOKOnly + vbInformation, myTitle)
  '
  Set myFso = Nothing
  Set myFile = Nothing
End Sub ' EspVortizoSchemaIni *----*----*    *----*----*    *----*----*    *----*----*