Sub EspRevizo()
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem エスペラント語辞書参照処理(即席スペルチェッカー)
  Rem 作譜:Hitrock Camellia Shinopy
  Rem 言語:Word VBA
  Rem 機能...
  Rem   選択した範囲にある単語に関して、エスペラント語の辞書データを参照する。
  Rem 注記...
  Rem   1. 「EspRevizoSetUp」を、「EspRevizo」初回実行前に先行して、一度だけ実行しておくこと。
  Rem   2. SQL文使用には、ファイル名にハイフンが使えないため、(やむを得ず)
  Rem      「pejvo-s.txt」ファイルをファイル名のハイフンをアンダーバーに変更してから、
  Rem      このマクロを実行すること。「pejvo-s.txt」→「pejvo_s.txt」
  Rem   3. 「EspRevizo」を起動して、ツールバーを追加し、コマンドボタンを押して、処理を実行する。
  Rem   4. [単語の点検]処理で、辞書にない単語に対し、蛍光ペン書式(水色/明るい緑)を設定する。
  Rem   5. 訳語ルビはフィールド表示を使用している。
  Rem   6. このマクロの一部に下記の「Espizo」のプロシージャを使用している。
  Rem      EspizoAeiou・EspizoCghjsu・EspizoOthers・
  Rem      EspizoRvAeiou・EspizoRvCghjsu・EspizoRvOthers
  Rem   7. 辞典の参照方法を、DictionaryオブジェクトからADOに変更したため、
  Rem      起動時の待ち時間はなくなりましたが、[単語の点検]の処理時間は長くなっています。
  Rem 履歴...
  Rem   第01版:2005/05/14 作成。
  Rem   (...)
  Rem   第22版:2007/01/07 Word2007以降に対応するため、バルーン表示を廃止。ツールバー表示に変更。
  Rem   第23版:2007/01/27...
  Rem     ポップアップ表示時にWordウィンドウ以外の箇所をクリックした場合に対応。
  Rem     訳語の表示で、「<英>」表示を「<mso>」に変更した。
  Rem   第24版:2007/01/30 アイコン表示変更。
  Rem   第25版:2007/03/05 空白表示をSpace関数に変更。
  Rem   第26版:2007/03/11...
  Rem     EspRevizoInitで、辞書ファイル「EspRevizoPcase.csv」「EspRevizoLcase.csv」の
  Rem     区切りを空白から「;」に変更。
  Rem   第27版:2007/11/01...
  Rem     他の言語のラテン文字に対応。EspizoUcOthers・EspizoRvOthersを追加。
  Rem   第28版:2008/07/03...
  Rem     複数形だけの単語で不具合が発生。「pluraj」の対格に対応。
  Rem   第29版:2008/08/21...
  Rem     FaceIdの指定を変更。「459」=>「964」(Word2007に対応)。
  Rem   第30版:2008/08/28:FaceIdを変更。(1613=>2533 1023=>44 1018=>2310)
  Rem   第31版:2008/10/13:呼び出す処理の引数を見直し。
  Rem   第32版:2008/10/26...
  Rem     EspRevizoKontroloの「Selection.Range.Words.Count > 1」時の処理を変更
  Rem    (Application.CheckSpelling・-[接尾辞]処理を追加)。
  Rem   第33版:2008/11/01...
  Rem     エスペラント語辞典読み込み処理(Dictionaryオブジェクト)を廃止、ADOを導入。
  Rem   第34版:2008/12/01...
  Rem     当マクロの一部の機能を、Windows音声認識で起動できるようにするため、
  Rem     ツールバーのCaptionプロパティ指定を変更。
  Rem   第35版:2010/09/25...
  Rem     Word 2010のCUSTOM.DICの保存先フォルダ変更に対応。
  Rem     「EspRevizoKontrolo」「EspRevizoRevizio」「EspRevizoPopItem」を変更。
  Rem   第36版:2010/11/11 「EspRevizoConst」の「専門分野略記号」を追加。
  Rem   第37版:2014/02/10 EspRevizoKontrolo・EspRevizoFleksioを見直し。
  Rem   第38版:2014/02/10 EspRevizoKontrolo内のChrW(39)(Apostrophe)対策(異常終了の予防)追加。
  Rem   第39版:2018/10/20 アイコンの変更:[Office辞書]・[単語の点検]。
  Rem   第40版:2021/01/27 "\CUSTOM.DIC"参照の修正。
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Dim myTitle As String
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Rem 既定値の設定
  Call EspRevizoConst("myTitle", myTitle)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Rem 同名ツールバーの削除
  On Error Resume Next
  CommandBars(myTitle).Delete
  On Error GoTo 0
  '
  Rem ステータスバーの表示
  Application.DisplayStatusBar = True
  '
  Rem ツールバー表示処理
  Dim myCmmdBar As CommandBar
  Dim myCtrlBttn As CommandBarControl
  Dim myCtrlCboxItem As CommandBarControl
  Dim myCtrlBttnSelr As CommandBarControl
  Dim myCtrlBttnOdic As CommandBarControl
  Dim myCtrlBttnRubi As CommandBarControl
  Dim myCtrlBttnRevizio As CommandBarControl
  Dim myCtrlBttnPopUp As CommandBarControl
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Set myCmmdBar = CommandBars.Add(Name:=myTitle, Position:=msoBarTop, Temporary:=True)
  '
  Set myCtrlBttn = myCmmdBar.Controls.Add(Type:=msoControlButton, Before:=1, Temporary:=True)
  Set myCtrlCboxItem = myCmmdBar.Controls.Add(Type:=msoControlDropdown, Before:=2, Temporary:=True)
  Set myCtrlBttnSelr = myCmmdBar.Controls.Add(Type:=msoControlButton, Before:=3, Temporary:=True)
  Set myCtrlBttnOdic = myCmmdBar.Controls.Add(Type:=msoControlButton, Before:=4, Temporary:=True)
  Set myCtrlBttnRubi = myCmmdBar.Controls.Add(Type:=msoControlButton, Before:=5, Temporary:=True)
  Set myCtrlBttnRevizio = myCmmdBar.Controls.Add(Type:=msoControlButton, Before:=6, Temporary:=True)
  Set myCtrlBttnPopUp = myCmmdBar.Controls.Add(Type:=msoControlButton, Before:=7, Temporary:=True)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  With myCtrlBttn
    .DescriptionText = "エスペラント語辞書参照処理(即席スペルチェッカー):選択した処理を実行します。"
    .Style = msoButtonIcon
    .Caption = "選択処理の実行" ' myTitle
    .TooltipText = "[ 選択処理の実行!]"
    .FaceId = 2533
    .OnAction = "EspRevizoBttn"
  End With
  '
  With myCtrlCboxItem
    .DescriptionText = "実行する処理を選択します。"
    .Style = msoComboNormal
    .Caption = "処理項目選択"
    '
    .AddItem "単語の点検", 1
    .AddItem "===========", 2
    .AddItem "蛍光ペン書式検索", 3
    .AddItem "===========", 4
    .AddItem "訳語の表示", 5
    .AddItem "===========", 6
    .AddItem "辞書に登録:明るい緑", 7
    .AddItem "辞書に登録:水色", 8
    .AddItem "===========", 9
    .AddItem "蛍光ペン書式解除", 10
    '
    .ListIndex = 0
    .Width = 130
    .TooltipText = "処理を選択して下さい。"
    .DropDownLines = 10
    .DropDownWidth = 200
    .OnAction = "EspRevizoCboxItem"
  End With
  '
  With myCtrlBttnSelr
    .DescriptionText = "[単語の点検]で、処理の対象となる範囲を指定します。"
    .Style = msoButtonIcon
    .Caption = "選択範囲指定"
    .TooltipText = "選択範囲の単語を点検する。"
    .FaceId = 44
    .OnAction = "EspRevizoBttnSelr"
  End With
  '
  With myCtrlBttnOdic
    .DescriptionText = "[単語の点検]で、Microsoft Office辞書の使用/不使用を指定します。"
    .Style = msoButtonIcon
    .Caption = "Office辞書"
    .TooltipText = "Officeの辞書も使用する。"
    .FaceId = 161 ' 4031
    .OnAction = "EspRevizoBttnOdic"
  End With
  '
  With myCtrlBttnRubi
    .DescriptionText = "[単語の点検]で、訳語ルビを表示/非表示を指定します。"
    .Style = msoButtonIcon
    .Caption = "訳語ルビ"
    .TooltipText = "訳語ルビは非表示にする。"
    .FaceId = 291
    .OnAction = "EspRevizoBttnRubi"
  End With
  '
  With myCtrlBttnRevizio
    .DescriptionText = "単語を点検します。"
    .BeginGroup = True
    .Style = msoButtonIcon
    .Caption = "単語の点検"
    .TooltipText = "[ 単語の点検 ]"
    .FaceId = 1087 ' 329
    .OnAction = "EspRevizoBttnRevizio"
  End With
  '
  With myCtrlBttnPopUp
    .DescriptionText = "訳語を表示を指定します。"
    .Style = msoButtonIcon
    .Caption = "訳語の表示"
    .TooltipText = "[ 訳語の表示 ]"
    .FaceId = 201
    .OnAction = "EspRevizoBttnPopUp"
  End With
  '
  myCmmdBar.Visible = True
  DoEvents
  Call EspRevizoBttn
End Sub ' EspRevizo *----*----*    *----*----*    *----*----*    *----*----*

Sub EspRevizoCboxItem(Optional myDummy As Boolean)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem [処理]コンボボックス処理
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Dim myTitle As String
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Call EspRevizoConst("myTitle", myTitle)
  '
  With CommandBars(myTitle).Controls(2)
    If .Text = "===========" Then
      .TooltipText = "処理が未選択です。"
    Else
      .TooltipText = .Text
    End If
  End With
End Sub ' EspRevizoCboxItem *----*----*    *----*----*    *----*----*    *----*----*

Sub EspRevizoBttnSelr(Optional myDummy As Boolean)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem [選択範囲]ボタン処理
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Dim myTitle As String
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Call EspRevizoConst("myTitle", myTitle)
  '
  With CommandBars(myTitle).Controls(3)
    If .FaceId = 44 Then
      .FaceId = 2310
      .TooltipText = "カーソルから後の単語を点検する。"
    Else
      .FaceId = 44
      .TooltipText = "選択範囲の単語を点検する。"
    End If
  End With
End Sub ' EspRevizoBttnSelr *----*----*    *----*----*    *----*----*    *----*----*

Sub EspRevizoBttnOdic(Optional myDummy As Boolean)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem [Office辞書]ボタン処理
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Dim myTitle As String
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Call EspRevizoConst("myTitle", myTitle)
  '
  With CommandBars(myTitle).Controls(4)
    If .FaceId = 161 Then ' 4031 Then
      .FaceId = 1104
      .TooltipText = "Officeの辞書は不使用にする。"
    Else
     .FaceId = 161 ' 4031
     .TooltipText = "Officeの辞書も使用する。"
    End If
  End With
End Sub ' EspRevizoBttnOdic *----*----*    *----*----*    *----*----*    *----*----*

Sub EspRevizoBttnRubi(Optional myDummy As Boolean)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem [訳語ルビ]ボタン処理
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Dim myTitle As String
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Call EspRevizoConst("myTitle", myTitle)
  '
  With CommandBars(myTitle).Controls(5)
    If .FaceId = 291 Then
      .FaceId = 2805
      .TooltipText = "訳語ルビを表示する。"
    Else
     .FaceId = 291
     .TooltipText = "訳語ルビは非表示にする。"
    End If
  End With
End Sub ' EspRevizoBttnRubi *----*----*    *----*----*    *----*----*    *----*----*

Sub EspRevizoBttnRevizio(Optional myDummy As Boolean)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem [単語の点検]ボタン処理
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Dim myTitle As String
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Call EspRevizoConst("myTitle", myTitle)
  '
  With CommandBars(myTitle).Controls(1)
    .FaceId = 329
  End With
  '
  Call EspRevizoBttn
End Sub ' EspRevizoBttnRevizio *----*----*    *----*----*    *----*----*    *----*----*

Sub EspRevizoBttnPopUp(Optional myDummy As Boolean)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem [訳語の表示]ボタン処理
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Dim myTitle As String
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Call EspRevizoConst("myTitle", myTitle)
  '
  With CommandBars(myTitle).Controls(1)
    .FaceId = 201
  End With
  '
  Call EspRevizoBttn
End Sub ' EspRevizoBttnPopUp *----*----*    *----*----*    *----*----*    *----*----*

Sub EspRevizoBttnMyOk(Optional myDummy As Boolean)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem コマンドボタン[OK]OnAction処理
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Dim myTitle As String
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Call EspRevizoConst("myTitle", myTitle)
  '
  CommandBars(myTitle).Controls(1).FaceId = 964
End Sub ' EspRevizoBttnMyOk *----*----*    *----*----*    *----*----*    *----*----*

Sub EspRevizoBttnMyCancel(Optional myDummy As Boolean)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem コマンドボタン[キャンセル]OnAction処理
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Dim myTitle As String
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Call EspRevizoConst("myTitle", myTitle)
  '
  CommandBars(myTitle).Controls(1).FaceId = 330
End Sub ' EspRevizoBttnMyCancel *----*----*    *----*----*    *----*----*    *----*----*

Sub EspRevizoBttnMyRetry(Optional myDummy As Boolean)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem コマンドボタン[再試行](選択範囲の先頭へ)OnAction処理
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Dim myTitle As String
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Call EspRevizoConst("myTitle", myTitle)
  '
  CommandBars(myTitle).Controls(1).FaceId = 154
End Sub ' EspRevizoBttnMyRetry *----*----*    *----*----*    *----*----*    *----*----*

Sub EspRevizoBttn(Optional myDummy As Boolean)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem 各ボタン処理
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Static myDic As Object
  '
  Dim myTitle As String
  Dim myBttn As Long
  Dim myLabel As String
  '
  Dim myDicPcase As String
  Dim myDicLcase As String
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Rem マクロ名・辞書ファイル名。
  Call EspRevizoConst("myTitle", myTitle)
  Call EspRevizoConst("myDicPcase", myDicPcase)
  Call EspRevizoConst("myDicLcase", myDicLcase)
  '
  If CommandBars(myTitle).Controls(1).FaceId = 2533 Then
    With CommandBars(myTitle).Controls(2)
      myLabel = .Text
      myBttn = .ListIndex
    End With
  Else
    Select Case CommandBars(myTitle).Controls(1).FaceId
      Case 329
        myLabel = CommandBars(myTitle).Controls(6).Caption
        myBttn = 1
      Case 201
        myLabel = CommandBars(myTitle).Controls(7).Caption
        myBttn = 5
    End Select
    CommandBars(myTitle).Controls(1).FaceId = 2533
  End If
  '
  Select Case myBttn
    Case 0
      CommandBars(myTitle).Controls(2).ListIndex = 3
      '
      Exit Sub
    Case 2, 4, 6, 9
      GoTo EspRevizoBttnSubExit
  End Select
  '
  Rem 辞書ファイルを開いている場合は、
  Rem [辞書に登録]ボタン以外は無効にする。
  If ActiveDocument.Name = myDicPcase Or ActiveDocument.Name = myDicLcase Then
    Select Case myBttn
      Case 7, 8
        Rem
      Case Else
        GoTo EspRevizoBttnSubExit
    End Select
  End If
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
EspRevizoBttnSubEntry:
  Select Case myBttn
    Case 1
      Call EspRevizoRevizio
    Case 3
      Call EspRevizoHiLight
    Case 5
      Call EspRevizoPopItem
    Case 7, 8
      Call EspRevizoLeksiko
    Case 10
      Call EspRevizoNoHiLight
  End Select
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
EspRevizoBttnSubExit:
  Rem 続けて処理する場合に備える。
  Application.ScreenUpdating = False
  CommandBars(myTitle).Enabled = False
  CommandBars(myTitle).Enabled = True
  Application.ScreenUpdating = True
  '
  Select Case myBttn
    Case 1, 3, 5, 7, 8, 10
      Application.StatusBar = myTitle & ":" & "処理完了!" & "[ " & myLabel & " ]"
  End Select
End Sub ' EspRevizoBttn *----*----*    *----*----*    *----*----*    *----*----*

Sub EspRevizoRevizio(Optional myDummy As Boolean)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem [単語の点検]
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Dim myLatin As String
  Dim myLatinEx As String
  Dim myMarks As String
  '
  Dim myRange As Range
  Dim myField As Fields
  Dim myChrs As Characters
  Dim myStartMarker As Word.Range
  '
  Dim i As Long
  Dim c As Long
  '
  Dim myWord As String
  Dim myItem As String
  Dim myCount As Long ' 辞書にない単語の数。
  Dim myFieldMax As Long ' フィールドが設定された単語の数
  Dim myFlag As Boolean
  Dim myHighlightColor As String
  '
  Dim myTitle As String
  Dim myStatusBar As String
  Dim myMsg As String
  Dim myAns As Long
  '
  Dim myCmmdBar As CommandBar
  Dim myCtrlBttn As CommandBarControl
  Dim myCtrlBttnOk As CommandBarControl
  Dim myCtrlBttnRetry As CommandBarControl
  Dim mySubName As String
  Dim myFaceId As Long
  '
  Rem 参照設定する場合:Microsoft VBScript Regular Expressions 5.5
  Dim myRegExp As Object ' VBScript_RegExp_55.RegExp
  Dim myMatches As Object ' MatchCollection
  Dim myMatch As Object ' Match
  Dim myPttn As String
  '
  Dim myConn As Object ' ADODB.Connection
  Dim myRecSet As Object ' ADODB.Recordset
  Dim DBPath As String
  Dim myCustomDic As String
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Call EspRevizoConst("myTitle", myTitle)
  Call EspRevizoConst("myFolder", DBPath)
  Call EspRevizoConst("AppData", myCustomDic)
    '  myCustomDic = myCustomDic & "\Microsoft\UProof\CUSTOM.DIC"
  myCustomDic = Application.CustomDictionaries.ActiveCustomDictionary.Path & "\CUSTOM.DIC"
  mySubName = "EspRevizoRevizio"
  '
  Set myRegExp = CreateObject("VBScript.RegExp") ' New VBScript_RegExp_55.RegExp
  '
  Rem Unicode(16進)によるラテン文字の文字コードの範囲を指定する。
  myLatin = "A-Za-z0-9" ' 基本ラテン文字
  myMarks = "\-\^\.@" ' 句読点:連字符・屈音符・終止符・単価記号
  myMarks = myMarks & "\u0027" & "\u2019" ' 句読点:単一引用符
  myLatinEx = ChrW(Val("&h00C0")) & "-" & ChrW(Val("&h00FF")) ' 拡張ラテン文字
  myLatinEx = myLatinEx & ChrW(Val("&h0100")) & "-" & ChrW(Val("&h017F"))
  myLatinEx = myLatinEx & ChrW(Val("&h0192")) & "-" & ChrW(Val("&h01FF"))
  myLatinEx = myLatinEx & ChrW(Val("&h1E80")) & "-" & ChrW(Val("&h1EF3"))
  '
  Rem パターンを指定
  myPttn = "[" & myLatin & myLatinEx & myMarks & "]+"
  myPttn = "[" & myLatinEx & "]?" & myPttn
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Rem [単語の点検]をする範囲を指定する。
  If CommandBars(myTitle).Controls(3).FaceId = 44 Then ' .TooltipText = "選択範囲の単語を点検する。"
    If Selection.Range.Text = "" Then
      Rem カーソルが単語の途中あると、不都合がなので、
      Rem カーソルを単語の先頭または末尾に移動させ、
      Rem カーソル位置から前にある段落の先頭までの範囲を選択する。
      Selection.Words(1).Select
      Select Case Selection.Range.Text
        Case vbVerticalTab, vbCr
          Rem カーソル位置が垂直タブ・改行の場合
          Selection.Collapse wdCollapseStart
          Selection.MoveUp Unit:=wdParagraph, Count:=1, Extend:=wdExtend
          Select Case Selection.Range.Text
            Case vbVerticalTab, vbCr
              Rem 垂直タブ・改行が2行続いた時、再度選択の処理をする。
              Selection.MoveUp Unit:=wdParagraph, Count:=1, Extend:=wdExtend
          End Select
        Case Else
          Selection.Collapse wdCollapseEnd
          Selection.MoveUp Unit:=wdParagraph, Count:=1, Extend:=wdExtend
      End Select
    End If
  Else
    Selection.Words(1).Select
    Selection.Collapse wdCollapseStart
    Rem カーソル位置から文書の末尾までの範囲を選択する。
    Selection.EndKey Unit:=wdStory, Extend:=wdExtend
  End If
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Set myRange = Selection.Range
  Set myField = myRange.Fields
  Set myChrs = myRange.Characters
  '
  If CommandBars(myTitle).Controls(5).FaceId = 291 Then ' .TooltipText =  "訳語ルビは非表示にする。"
    Rem [訳語ルビ]オフの時、ルビを削除する。
    myFieldMax = myField.Count
    For i = myField.Count To 1 Step -1
      myField.Item(i).Select
      If InStr(myField.Item(i).Code, "\o(\s\up") > 0 Then
        With Selection
          .Start = .Range.Start
          .End = .Range.End
          .Range.PhoneticGuide Text:=""
        End With
      End If
      '
      c = (myFieldMax + 1 - i) * 100 \ myFieldMax
      myStatusBar = " [" & "ルビ削除" & "] " & Format(c, "##0") & "%"
      Application.StatusBar = myTitle & ":処理中" & myStatusBar
      DoEvents
    Next ' i
  End If
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  myRange.Select
  With myRegExp
    .Pattern = myPttn ' パターンを設定
    .IgnoreCase = False ' 大文字と小文字を区別する
    .Global = True ' 文字列全体を検索
  End With
  Set myMatches = myRegExp.Execute(myRange.Text)
  '
  Rem 検索開始点の取得。
  Selection.Collapse wdCollapseStart
  Set myStartMarker = Selection.Range
  myCount = 0
  '
  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 ラテン文字の単語を検索。
  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
      Rem *----*----*    *----*----*
      '
      myFlag = False
      myItem = ""
      myWord = Selection.Range.Text
      Call EspRevizoKontrolo(myFlag, myWord, myItem, myCustomDic, myConn, myRecSet)
      Rem *----*----*    *----*----*
      '
      Rem 辞書にない単語を蛍光ペン書式にする。
      If myFlag = True Then
        Selection.Range.HighlightColorIndex = wdNoHighlight
      Else
        If Right(Selection.Range.Text, 1) = "." Then
          Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
        End If
        '
        Select Case Left(Selection.Range.Text, 1)
          Case "A" To "Z"
            myHighlightColor = wdBrightGreen ' 明るい緑
          Case ChrW(194), ChrW(202), ChrW(206), ChrW(212), ChrW(219)
            Rem A_ E_ I_ O_ U_
            myHighlightColor = wdBrightGreen ' 明るい緑
          Case ChrW(264), ChrW(284), ChrW(292), ChrW(308), ChrW(348), ChrW(364)
            Rem C^ G^ H^ J^ S^ U^
            myHighlightColor = wdBrightGreen ' 明るい緑
          Case Else
            myHighlightColor = wdTurquoise ' 水色
        End Select
        Selection.Range.HighlightColorIndex = myHighlightColor
        myCount = myCount + 1
      End If
      '
      Rem 訳語ルビ設定。
      If CommandBars(myTitle).Controls(5).FaceId = 2805 Then ' .TooltipText =  "訳語ルビを表示する。"
        Call EspRevizoPhGuide(myItem)
      End If
      '
      If Not Selection.Range.Characters.Last.Next Is Nothing Then
        If Selection.Range.Characters.Last.Next.Text = "." Then
          Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
        End If
      End If
      Rem *----*----*    *----*----*
      '
      c = (i + 1) * 100 \ myMatches.Count
      myStatusBar = Format(c, "##0") & "%"
      Application.StatusBar = myTitle & ":処理中" & " " & myStatusBar
      '
      Selection.Collapse wdCollapseEnd
      DoEvents
    Next ' i
  End With
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  On Error Resume Next
  CommandBars(mySubName).Delete
  On Error GoTo 0
  '
  If myCount > 0 Then
    Set myCmmdBar = CommandBars.Add(Name:=mySubName, Position:=msoBarPopup, Temporary:=True)
    Set myCtrlBttn = myCmmdBar.Controls.Add(Type:=msoControlButton, Before:=1, Temporary:=True)
    Set myCtrlBttnOk = myCmmdBar.Controls.Add(Type:=msoControlButton, Before:=2, Temporary:=True)
    '
    myMsg = "辞書にない単語が、" & vbCrLf
    myMsg = myMsg & myCount & "箇所ありました。"
    '
    With myCtrlBttn
      .DescriptionText = "[単語の点検]処理後ポップアップメニュー"
      .Style = msoButtonIconAndWrapCaption
      .Caption = myTitle & vbCrLf & "[単語の点検]" & vbCrLf & myMsg
      .TooltipText = "辞書にない単語がありました。"
      .FaceId = 463
      myFaceId = .FaceId
    End With
    '
    With myCtrlBttnOk
      .DescriptionText = "[単語の点検]処理:[選択範囲の先頭へ]ボタン"
      .BeginGroup = True
      .Style = msoButtonIconAndCaption
      .Caption = "[選択範囲の先頭へ]" & Space(26)
      .TooltipText = "カーソルを選択範囲の先頭へ戻します。"
      .FaceId = 154
      .OnAction = "EspRevizoBttnMyRetry"
    End With
  Else
    Set myCmmdBar = CommandBars.Add(Name:=mySubName, Position:=msoBarPopup, Temporary:=True)
    Set myCtrlBttn = myCmmdBar.Controls.Add(Type:=msoControlButton, Before:=1, Temporary:=True)
    Set myCtrlBttnRetry = myCmmdBar.Controls.Add(Type:=msoControlButton, Before:=2, Temporary:=True)
    Set myCtrlBttnOk = myCmmdBar.Controls.Add(Type:=msoControlButton, Before:=3, Temporary:=True)
    '
    myMsg = "辞書にない単語は、発見できませんでした。"
    '
    With myCtrlBttn
      .DescriptionText = "[単語の点検]処理後ポップアップメニュー"
      .Style = msoButtonIconAndWrapCaption
      .Caption = myTitle & vbCrLf & "[単語の点検]" & vbCrLf & myMsg
      .TooltipText = "辞書にない単語は、発見できませんでした。"
      .FaceId = 487
      myFaceId = .FaceId
    End With
    '
    With myCtrlBttnRetry
      .DescriptionText = "[単語の点検]処理:[選択範囲の先頭へ]ボタン"
      .BeginGroup = True
      .Style = msoButtonIconAndCaption
      .Caption = "[選択範囲の先頭へ]" & Space(26)
      .TooltipText = "カーソルを選択範囲の先頭へ戻します。"
      .FaceId = 154
      .OnAction = "EspRevizoBttnMyRetry"
    End With
    '
    With myCtrlBttnOk
      .DescriptionText = "[単語の点検]処理:[OK]ボタン"
      .BeginGroup = True
      .Style = msoButtonIconAndCaption
      .Caption = "OK"
      .TooltipText = "辞書にない単語は、発見できませんでした。"
      .FaceId = 964
      .OnAction = "EspRevizoBttnMyOk"
    End With
  End If
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  CommandBars(myTitle).Controls(1).FaceId = myFaceId
  Beep
  Do
    On Error Resume Next
    myCmmdBar.ShowPopup
    On Error GoTo 0
    DoEvents
    If CommandBars(myTitle).Controls(1).FaceId <> myFaceId Then Exit Do
  Loop
  '
  Select Case CommandBars(myTitle).Controls(1).FaceId
    Case 154
      myAns = vbRetry
    Case Else
      myAns = vbOK
  End Select
  '
  If myAns = vbRetry Then
    Rem 検索開始点に戻る。
    myStartMarker.Select
  Else
    myChrs.Last.Select
    Selection.Collapse wdCollapseEnd
  End If
  '
  On Error Resume Next
  myConn.Close
  myCmmdBar.Delete
  CommandBars(myTitle).Controls(1).FaceId = 2533
  On Error GoTo 0
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Set myRegExp = Nothing
  Set myMatches = Nothing
  Set myRange = Nothing
  Set myField = Nothing
  Set myChrs = Nothing
  Set myStartMarker = Nothing
  '
  Set myConn = Nothing
  Set myRecSet = Nothing
  '
  Set myCmmdBar = Nothing
  Set myCtrlBttn = Nothing
  Set myCtrlBttnOk = Nothing
  Set myCtrlBttnRetry = Nothing
End Sub ' EspRevizoRevizio *----*----*    *----*----*    *----*----*    *----*----*

Sub EspRevizoLeksiko(Optional myDummy As Boolean)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem [辞書に登録]
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Dim myFolder As String
  Dim myFullName As String
  Dim myDicPcase As String
  Dim myDicLcase As String
  Dim myDicName As String
  '
  Dim myHighlightColor As String
  Dim myStartMarker As Word.Range
  Dim myPara As Paragraph
  Dim myCount As Long
  '
  Dim myText As String
  Dim myKey As String
  Dim myItem As String
  '
  Dim myTitle As String
  Dim myMsg As String
  Dim myAns As Long
  '
  Dim myCmmdBar As CommandBar
  Dim myCtrlBttn As CommandBarControl
  Dim myCtrlBttnOk As CommandBarControl
  Dim myCtrlBttnCancel As CommandBarControl
  Dim mySubName As String
  Dim myFaceId As Long
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Rem マクロ名・関連フォルダ名・関連ファイル名。
  Call EspRevizoConst("myTitle", myTitle)
  Call EspRevizoConst("myFolder", myFolder)
  Call EspRevizoConst("myDicPcase", myDicPcase)
  Call EspRevizoConst("myDicLcase", myDicLcase)
  mySubName = "EspRevizoLeksiko"
  '
  Select Case ActiveDocument.Name
    Case myDicPcase, myDicLcase
      GoTo EspRevizoLeksikoSubEntry
  End Select
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Select Case CommandBars(myTitle).Controls(2).ListIndex
    Case 7 ' "辞書に登録:明るい緑"
      myDicName = myDicPcase
      myHighlightColor = wdBrightGreen ' 明るい緑
    Case 8 ' "辞書に登録::水色"
      myDicName = myDicLcase
      myHighlightColor = wdTurquoise ' 水色
  End Select
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  myCount = 0
  Call EspRevizoDicSelect(myFolder, myDicName, myHighlightColor, myCount)
  '
  On Error Resume Next
  CommandBars(mySubName).Delete
  On Error GoTo 0
  '
  Set myCmmdBar = CommandBars.Add(Name:=mySubName, Position:=msoBarPopup, Temporary:=True)
  Set myCtrlBttn = myCmmdBar.Controls.Add(Type:=msoControlButton, Before:=1, Temporary:=True)
  Set myCtrlBttnOk = myCmmdBar.Controls.Add(Type:=msoControlButton, Before:=2, Temporary:=True)
  '
  If myCount > 0 Then
    myMsg = "単語を辞書に登録する準備ができました!" & vbCrLf & vbCrLf
    myMsg = myMsg & myCount & "件の追加する単語があります。" & vbCrLf
    myMsg = myMsg & "訳語を入力して下さい。" & vbCrLf & vbCrLf
    myMsg = myMsg & "文書上の単語を辞書に登録する場合は、" & vbCrLf
    myMsg = myMsg & "再度[辞書に登録]を実行して下さい。"
    '
    With myCtrlBttn
      .DescriptionText = "[辞書に登録]処理前ポップアップメニュー"
      .Style = msoButtonIconAndWrapCaption
      .Caption = myTitle & vbCrLf & "[辞書に登録]" & vbCrLf & myMsg
      .TooltipText = "訳語を入力して、再度[辞書に登録]を単語を登録して下さい。"
      .FaceId = 463
      myFaceId = .FaceId
    End With
    '
    With myCtrlBttnOk
      .DescriptionText = "[辞書に登録]処理:[OK]ボタン"
      .BeginGroup = True
      .Style = msoButtonIconAndCaption
      .Caption = "OK" & Space(48)
      .TooltipText = "この後、訳語を入力して下さい。"
      .FaceId = 964
      .OnAction = "EspRevizoBttnMyOk"
    End With
  Else
    myMsg = "該当する単語は、ありませんでした。"
    '
    With myCtrlBttn
      .DescriptionText = "[辞書に登録]処理前ポップアップメニュー"
      .Style = msoButtonIconAndWrapCaption
      .Caption = myTitle & vbCrLf & "[辞書に登録]" & vbCrLf & myMsg
      .TooltipText = "該当する蛍光ペン書式の単語がありません。"
      .FaceId = 1019
      myFaceId = .FaceId
    End With
    '
    With myCtrlBttnOk
      .DescriptionText = "[辞書に登録]処理:[OK]ボタン"
      .BeginGroup = True
      .Style = msoButtonIconAndCaption
      .Caption = "OK" & Space(48)
      .TooltipText = "処理を中止します。"
      .FaceId = 964
      .OnAction = "EspRevizoBttnMyOk"
    End With
  End If
  Rem *----*----*    *----*----*    *----*----*    *----*----*'
  '
  CommandBars(myTitle).Controls(1).FaceId = myFaceId
  Beep
  Do
    On Error Resume Next
    myCmmdBar.ShowPopup
    On Error GoTo 0
    DoEvents
    If CommandBars(myTitle).Controls(1).FaceId <> myFaceId Then Exit Do
  Loop
  '
  On Error Resume Next
  myCmmdBar.Delete
  CommandBars(myTitle).Controls(1).FaceId = 2533
  On Error GoTo 0
  '
  GoTo EspRevizoLeksikoSubExit
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
EspRevizoLeksikoSubEntry:
  myDicName = ActiveDocument.Name
  myFullName = myFolder & "\" & myDicName
  '
  On Error Resume Next
  CommandBars(mySubName).Delete
  On Error GoTo 0
  '
  Set myCmmdBar = CommandBars.Add(Name:=mySubName, Position:=msoBarPopup, Temporary:=True)
  Set myCtrlBttn = myCmmdBar.Controls.Add(Type:=msoControlButton, Before:=1, Temporary:=True)
  Set myCtrlBttnOk = myCmmdBar.Controls.Add(Type:=msoControlButton, Before:=2, Temporary:=True)
  Set myCtrlBttnCancel = myCmmdBar.Controls.Add(Type:=msoControlButton, Before:=3, Temporary:=True)
  '
  myMsg = "単語を辞書に登録します。" & vbCrLf
  myMsg = myMsg & "( " & myDicName & " ) " & vbCrLf & vbCrLf
  myMsg = myMsg & "処理を中止したい場合は、" & vbCrLf
  myMsg = myMsg & "[キャンセル]を選択して下さい。"
  '
  With myCtrlBttn
    .DescriptionText = "[辞書に登録]処理前ポップアップメニュー"
    .Style = msoButtonIconAndWrapCaption
    .Caption = myTitle & vbCrLf & "[辞書に登録]" & vbCrLf & myMsg
    .TooltipText = "単語を辞書に登録します。"
    .FaceId = 1089
    myFaceId = .FaceId
  End With
  '
  With myCtrlBttnOk
    .DescriptionText = "[辞書に登録]処理:[OK]ボタン"
    .BeginGroup = True
    .Style = msoButtonIconAndCaption
    .Caption = "OK" & Space(48)
    .TooltipText = "この後、訳語を入力して下さい。"
    .FaceId = 964
    .OnAction = "EspRevizoBttnMyOk"
  End With
  '
  With myCtrlBttnCancel
    .DescriptionText = "[辞書に登録]処理:[キャンセル]ボタン"
    .BeginGroup = True
    .Style = msoButtonIconAndCaption
    .Caption = "キャンセル"
    .TooltipText = "[辞書に登録]処理を中止します。"
    .FaceId = 330
    .OnAction = "EspRevizoBttnMyCancel"
  End With
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  CommandBars(myTitle).Controls(1).FaceId = myFaceId
  Beep
  Do
    On Error Resume Next
    myCmmdBar.ShowPopup
    On Error GoTo 0
    DoEvents
    If CommandBars(myTitle).Controls(1).FaceId <> myFaceId Then Exit Do
  Loop
  '
  Select Case CommandBars(myTitle).Controls(1).FaceId
    Case 964
      myAns = vbOK
    Case Else
      myAns = vbCancel
  End Select
  '
  On Error Resume Next
  myCmmdBar.Delete
  CommandBars(myTitle).Controls(1).FaceId = 2533
  On Error GoTo 0
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  If myAns <> vbOK Then GoTo EspRevizoLeksikoSubExit
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Rem 辞書の文書を保存。テキスト形式で保存。
  ActiveDocument.SaveAs FileName:=myFullName, FileFormat:=wdFormatText, AddToRecentFiles:=False
  Rem 文書を閉じる。
  ActiveDocument.Close
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  myMsg = "辞書に単語を登録しました。" & vbCrLf
  myMsg = myMsg & "( " & myDicName & " )"
  '
  On Error Resume Next
  CommandBars(mySubName).Delete
  On Error GoTo 0
  '
  Set myCmmdBar = CommandBars.Add(Name:=mySubName, Position:=msoBarPopup, Temporary:=True)
  Set myCtrlBttn = myCmmdBar.Controls.Add(Type:=msoControlButton, Before:=1, Temporary:=True)
  Set myCtrlBttnOk = myCmmdBar.Controls.Add(Type:=msoControlButton, Before:=2, Temporary:=True)
  '
  With myCtrlBttn
    .DescriptionText = "[辞書に登録]処理後ポップアップメニュー"
    .Style = msoButtonIconAndWrapCaption
    .Caption = myTitle & vbCrLf & "[辞書に登録]" & vbCrLf & myMsg
    .TooltipText = "[辞書に登録]を実行しました。"
    .FaceId = 487
    myFaceId = .FaceId
  End With
  '
  With myCtrlBttnOk
    .DescriptionText = "[辞書に登録]処理:[OK]ボタン"
    .BeginGroup = True
    .Style = msoButtonIconAndCaption
    .Caption = "OK" & Space(32)
    .TooltipText = "[辞書に登録]を実行しました。"
    .FaceId = 964
    .OnAction = "EspRevizoBttnMyOk"
  End With
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  CommandBars(myTitle).Controls(1).FaceId = myFaceId
  Beep
  Do
    On Error Resume Next
    myCmmdBar.ShowPopup
    On Error GoTo 0
    DoEvents
    If CommandBars(myTitle).Controls(1).FaceId <> myFaceId Then Exit Do
  Loop
  '
  On Error Resume Next
  myCmmdBar.Delete
  CommandBars(myTitle).Controls(1).FaceId = 2533
  On Error GoTo 0
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
EspRevizoLeksikoSubExit:
  Set myCmmdBar = Nothing
  Set myCtrlBttn = Nothing
  Set myCtrlBttnOk = Nothing
  Set myCtrlBttnCancel = Nothing
End Sub ' EspRevizoLeksiko *----*----*    *----*----*    *----*----*    *----*----*

Sub EspRevizoHiLight(Optional myDummy As Boolean)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem [蛍光ペン書式検索](水色・明るい緑)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Dim myCount As Long
  Dim myTitle As String
  Dim myMsg As String
  '
  Dim myCmmdBar As CommandBar
  Dim myCtrlBttn As CommandBarControl
  Dim myCtrlBttnOk As CommandBarControl
  Dim mySubName As String
  Dim myFaceId As Long
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Call EspRevizoConst("myTitle", myTitle)
  mySubName = "EspRevizoHiLight"
  '
  If Selection.Range.Text <> "" Then
    Selection.Collapse wdCollapseEnd
    Exit Sub
  End If
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
EspRevizoHiLightSubEntry:
  Rem 蛍光ペン書式を検索。
  With Selection.Find
    .ClearFormatting
    .Highlight = True ' 蛍光ペン書式を検索することを指定
    .Text = ""
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
  End With
  '
  Rem 検索を実行。
  Do While Selection.Find.Execute
    Select Case Selection.Range.HighlightColorIndex
      Case wdTurquoise, wdBrightGreen
        Rem ルビなどのフィールドが設定されている場合は、フィールドを解除する。
        If AscW(Selection.Range.Words.Item(1).Text) = 21 Then
          With Selection
            .MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
            .Start = .Range.Characters.First.Start
            .End = .Range.Characters.Last.End
            .Range.PhoneticGuide Text:="", Alignment:=wdPhoneticGuideAlignmentCenter, _
             Raise:=9, FontSize:=5, FontName:="MS UI Gothic"
            .Find.Execute ' カーソルが単語の先頭に行くため、再検索し、単語を選択状態にする。
          End With
        End If
      Exit Do
    End Select
    DoEvents
  Loop
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  If Not Selection.Find.Found Then
    On Error Resume Next
    CommandBars(mySubName).Delete
    On Error GoTo 0
    '
    Set myCmmdBar = CommandBars.Add(Name:=mySubName, Position:=msoBarPopup, Temporary:=True)
    Set myCtrlBttn = myCmmdBar.Controls.Add(Type:=msoControlButton, Before:=1, Temporary:=True)
    Set myCtrlBttnOk = myCmmdBar.Controls.Add(Type:=msoControlButton, Before:=2, Temporary:=True)
    '
    myMsg = "該当する書式は、ありません。"
    '
    With myCtrlBttn
      .DescriptionText = "[蛍光ペン書式検索]処理後ポップアップメニュー"
      .Style = msoButtonIconAndWrapCaption
      .Caption = myTitle & vbCrLf & "[蛍光ペン書式検索]" & vbCrLf & myMsg
      .TooltipText = "[蛍光ペン書式検索]を実行しました。"
      .FaceId = 1019
      myFaceId = .FaceId
    End With
    '
    With myCtrlBttnOk
      .DescriptionText = "[蛍光ペン書式検索]処理:[OK]ボタン"
      .BeginGroup = True
      .Style = msoButtonIconAndCaption
      .Caption = "OK" & Space(32)
      .TooltipText = "該当する書式は、ありません。"
      .FaceId = 964
      .OnAction = "EspRevizoBttnMyOk"
    End With
    Rem *----*----*    *----*----*    *----*----*    *----*----*
    '
    CommandBars(myTitle).Controls(1).FaceId = myFaceId
    Beep
    Do
      On Error Resume Next
      myCmmdBar.ShowPopup
      On Error GoTo 0
      DoEvents
      If CommandBars(myTitle).Controls(1).FaceId <> myFaceId Then Exit Do
    Loop
    '
    On Error Resume Next
    myCmmdBar.Delete
    CommandBars(myTitle).Controls(1).FaceId = 2533
    On Error GoTo 0
  End If
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
EspRevizoHiLightSubExit:
  Set myCmmdBar = Nothing
  Set myCtrlBttn = Nothing
  Set myCtrlBttnOk = Nothing
End Sub ' EspRevizoHiLight *----*----*    *----*----*    *----*----*    *----*----*

Sub EspRevizoNoHiLight(Optional myDummy As Boolean)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem [蛍光ペン書式解除]
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Dim myStartMarker As Word.Range
  Dim myCount As Long
  Dim myTitle As String
  Dim myMsg As String
  Dim myAns As Long
  '
  Dim myCmmdBar As CommandBar
  Dim myCtrlBttn As CommandBarControl
  Dim myCtrlBttnOk As CommandBarControl
  Dim myCtrlBttnCancel As CommandBarControl
  Dim mySubName As String
  Dim myFaceId As Long
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Call EspRevizoConst("myTitle", myTitle)
  mySubName = "EspRevizoNoHiLight"
  '
  On Error Resume Next
  CommandBars(mySubName).Delete
  On Error GoTo 0
  '
  Set myCmmdBar = CommandBars.Add(Name:=mySubName, Position:=msoBarPopup, Temporary:=True)
  Set myCtrlBttn = myCmmdBar.Controls.Add(Type:=msoControlButton, Before:=1, Temporary:=True)
  Set myCtrlBttnOk = myCmmdBar.Controls.Add(Type:=msoControlButton, Before:=2, Temporary:=True)
  Set myCtrlBttnCancel = myCmmdBar.Controls.Add(Type:=msoControlButton, Before:=3, Temporary:=True)
  '
  myMsg = "カーソル位置以降の" & vbCrLf
  myMsg = myMsg & "蛍光ペン書式を解除します。"
  '
  With myCtrlBttn
    .DescriptionText = "[蛍光ペン書式解除]処理前ポップアップメニュー"
    .Style = msoButtonIconAndWrapCaption
    .Caption = myTitle & vbCrLf & "[蛍光ペン書式解除]" & vbCrLf & myMsg
    .TooltipText = "[蛍光ペン書式解除]を実行しますか?"
    .FaceId = 1089
    myFaceId = .FaceId
  End With
  '
  With myCtrlBttnOk
    .DescriptionText = "[蛍光ペン書式解除]処理:[OK]ボタン"
    .BeginGroup = True
    .Style = msoButtonIconAndCaption
    .Caption = "OK"
    .TooltipText = "[蛍光ペン書式解除]を実行!"
    .FaceId = 964
    .OnAction = "EspRevizoBttnMyOk"
  End With
  '
  With myCtrlBttnCancel
    .DescriptionText = "[蛍光ペン書式解除]処理:[キャンセル]ボタン"
    .BeginGroup = True
    .Style = msoButtonIconAndCaption
    .Caption = "キャンセル" & Space(24)
    .TooltipText = "[蛍光ペン書式解除]処理を中止します。"
    .FaceId = 330
    .OnAction = "EspRevizoBttnMyCancel"
  End With
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  CommandBars(myTitle).Controls(1).FaceId = myFaceId
  Beep
  Do
    On Error Resume Next
    myCmmdBar.ShowPopup
    On Error GoTo 0
    DoEvents
    If CommandBars(myTitle).Controls(1).FaceId <> myFaceId Then Exit Do
  Loop
  '
  Select Case CommandBars(myTitle).Controls(1).FaceId
    Case 964
      myAns = vbOK
    Case Else
      myAns = vbCancel
  End Select
  '
  On Error Resume Next
  myCmmdBar.Delete
  CommandBars(myTitle).Controls(1).FaceId = 2533
  On Error GoTo 0
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  If myAns <> vbOK Then
    GoTo EspRevizoNoHiLightSubExit
  End If
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
EspRevizoNoHiLightSubEntry:
  Rem 検索開始点の取得。
  Selection.Collapse wdCollapseStart
  Set myStartMarker = Selection.Range
  Rem  Selection.HomeKey Unit:=wdStory ' 一括変換の場合は、注釈を外す。
  myCount = 0
  '
  Rem 蛍光ペン書式を検索。
  With Selection.Find
    .ClearFormatting
    .Highlight = True ' 蛍光ペンを検索することを指定
    .Text = ""
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
  End With
  '
  Rem 検索を実行。
  Do While Selection.Find.Execute
    Select Case Selection.Range.HighlightColorIndex
      Case wdBrightGreen, wdTurquoise ' ' 明るい緑・水色
        Rem ルビなどのフィールドが設定されている場合は、フィールドを解除する。
        If AscW(Selection.Range.Words.Item(1).Text) = 21 Then
          With Selection
            .MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
            .Start = .Range.Characters.First.Start
            .End = .Range.Characters.Last.End
            .Range.PhoneticGuide Text:="", Alignment:=wdPhoneticGuideAlignmentCenter, _
             Raise:=9, FontSize:=5, FontName:="MS UI Gothic"
            .Find.Execute ' カーソルが単語の先頭に行くため、再検索し、単語を選択状態にする。
          End With
        End If
        Selection.Range.HighlightColorIndex = wdNoHighlight
        myCount = myCount + 1
    End Select
    Selection.Collapse wdCollapseEnd
  Loop
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  On Error Resume Next
  CommandBars(mySubName).Delete
  On Error GoTo 0
  '
  Set myCmmdBar = CommandBars.Add(Name:=mySubName, Position:=msoBarPopup, Temporary:=True)
  Set myCtrlBttn = myCmmdBar.Controls.Add(Type:=msoControlButton, Before:=1, Temporary:=True)
  Set myCtrlBttnOk = myCmmdBar.Controls.Add(Type:=msoControlButton, Before:=2, Temporary:=True)
  '
  If myCount = 0 Then
    Rem 蛍光ペン書式の文字列がない場合。
    myMsg = "該当する書式は、ありません。"
  Else
    myMsg = "蛍光ペン書式を解除しました。"
  End If
  '
  With myCtrlBttn
    .DescriptionText = "[蛍光ペン書式解除]処理後ポップアップメニュー"
    .Style = msoButtonIconAndWrapCaption
    .Caption = myTitle & vbCrLf & "[蛍光ペン書式解除]" & vbCrLf & myMsg
    .TooltipText = "[蛍光ペン書式解除]を実行しました。"
    If myCount = 0 Then
      .FaceId = 1019
    Else
      .FaceId = 487
    End If
    myFaceId = .FaceId
  End With
  '
  With myCtrlBttnOk
    .DescriptionText = "[蛍光ペン書式解除]処理:[OK]ボタン"
    .BeginGroup = True
    .Style = msoButtonIconAndCaption
    .Caption = "OK" & Space(36)
    If myCount = 0 Then
      .TooltipText = "該当する書式は、ありません。"
    Else
      .TooltipText = "蛍光ペン書式を解除しました。"
    End If
    .FaceId = 964
    .OnAction = "EspRevizoBttnMyOk"
  End With
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  CommandBars(myTitle).Controls(1).FaceId = myFaceId
  Beep
  Do
    On Error Resume Next
    myCmmdBar.ShowPopup
    On Error GoTo 0
    DoEvents
    If CommandBars(myTitle).Controls(1).FaceId <> myFaceId Then Exit Do
  Loop
  '
  On Error Resume Next
  myCmmdBar.Delete
  CommandBars(myTitle).Controls(1).FaceId = 2533
  On Error GoTo 0
  Rem *----*----*    *----*----*    *----*----*    *----*----*
 '
  Rem 検索開始点に戻る。
  myStartMarker.Select
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
EspRevizoNoHiLightSubExit:
  Set myCmmdBar = Nothing
  Set myCtrlBttn = Nothing
  Set myCtrlBttnOk = Nothing
  Set myCtrlBttnCancel = Nothing
  '
  Set myStartMarker = Nothing
End Sub ' EspRevizoNoHiLight *----*----*    *----*----*    *----*----*    *----*----*

Sub EspRevizoPopItem(Optional myDummy As Boolean)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem [訳語の表示]
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Dim myLatin As String
  Dim myLatinEx As String
  Dim myMarks As String
  Dim myPttn As String
  '
  Dim myFlagChrs As Boolean
  Dim myCount As Long
  Dim i As Long
  '
  Dim myFlag As Boolean
  Dim myWord As String
  Dim myWordPrev As String
  Dim myItem As String
  '
  Dim myTitle As String
  Dim myText As String
  Dim myMsg As String
  Dim myAns As Long
  '
  Dim myCmmdBar As CommandBar
  Dim myCtrlBttn As CommandBarControl
  Dim myCtrlBttnOk As CommandBarControl
  Dim mySubName As String
  Dim myFaceId As Long
  '
  Dim myConn As Object ' ADODB.Connection
  Dim myRecSet As Object ' ADODB.Recordset
  Dim DBPath As String
  Dim myCustomDic As String
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Call EspRevizoConst("myTitle", myTitle)
  Call EspRevizoConst("myFolder", DBPath)
  Call EspRevizoConst("AppData", myCustomDic)
  myCustomDic = myCustomDic & "\Microsoft\UProof\CUSTOM.DIC"
  mySubName = "EspRevizoPopItem"
  '
  Rem Unicode(16進)によるラテン文字の文字コードの範囲を指定する。
  myLatin = "A-Za-z0-9" ' 基本ラテン文字
  myMarks = "\-^^.\@" ' 句読点:連字符・屈音符・終止符・単価記号
  myMarks = myMarks & "\u0027" & "\u2019" ' 句読点:単一引用符
  myLatinEx = ChrW(Val("&h00C0")) & "-" & ChrW(Val("&h00FF")) ' 拡張ラテン文字
  myLatinEx = myLatinEx & ChrW(Val("&h0100")) & "-" & ChrW(Val("&h017F"))
  myLatinEx = myLatinEx & ChrW(Val("&h0192")) & "-" & ChrW(Val("&h01FF"))
  myLatinEx = myLatinEx & ChrW(Val("&h1E80")) & "-" & ChrW(Val("&h1EF3"))
  myPttn = "[" & myLatin & myLatinEx & myMarks & "]" & "{1,}"
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  myWord = ""
  Rem 単語の取得
  Selection.Expand (wdWord)
  Select Case Selection.Range.Text
    Case vbCr, vbVerticalTab, vbTab, vbFormFeed, vbLf
      Selection.MoveLeft Unit:=wdCharacter, Count:=2, Extend:=wdMove
      Selection.Expand (wdWord)
  End Select
  '
  If AscW(Selection.Range.Text) = 21 Then
    If InStr(Selection.Range.Fields(1).Code, "\o(\s\up") > 0 Then
      Rem 選択範囲が[訳語ルビ]の場合
      i = InStrRev(Selection.Range.Fields(1).Code, "),")
      myWord = Mid(Selection.Range.Fields(1).Code, i + 2)
      myWord = Left(myWord, Len(myWord) - 1)
      With Selection
        .Start = .Range.Characters.First.Start
        .End = .Range.Characters.Last.End
        .Range.PhoneticGuide Text:="", Alignment:=wdPhoneticGuideAlignmentCenter, _
         Raise:=9, FontSize:=5, FontName:="MS UI Gothic"
      End With
      '
      Rem 単語を検索して範囲選択する。
      With Selection.Find
        .ClearFormatting
        .Text = myWord
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindStop
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchFuzzy = False
        .MatchWildcards = False
        .Execute
      End With
    End If
    Rem *----*----*    *----*----*
  Else
    Rem 選択範囲が[訳語ルビ]でない場合
    Selection.Collapse wdCollapseStart
    If AscW(Selection.Range.Characters.First.Text) <= 32 Then Exit Sub
    '
    Do
      Rem 文字列の先頭を探す。
      myFlagChrs = False
      If Not Selection.Range.Characters.First.Previous Is Nothing Then
        If Selection.Range.Characters.First.Previous.Text Like myPttn Then
          myFlagChrs = True
          Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdMove
        End If
      End If
      '
      If myFlagChrs = False Then Exit Do
    Loop
    '
    Do
      Rem 文字列の先頭がラテン文字の場合、単語の先頭と見なす。
      myFlagChrs = False
      If Selection.Range.Characters.First.Text Like "[" & myLatin & myLatinEx & "]" Then
        myFlagChrs = True
      Else
        myCount = Selection.MoveRight(Unit:=wdCharacter, Count:=1, Extend:=wdMove)
        If myCount = 0 Then Exit Sub
      End If
      '
      If myFlagChrs = True Then Exit Do
    Loop
    '
    Rem 単語を検索して範囲選択する。
    With Selection.Find
      .ClearFormatting
      .Text = myPttn
      .Replacement.Text = ""
      .Forward = True
      .Wrap = wdFindStop
      .MatchAllWordForms = False
      .MatchSoundsLike = False
      .MatchFuzzy = False
      .MatchWildcards = True
      .Execute
    End With
    '
    myWord = Selection.Range.Text
  End If
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  myFlag = False
  myItem = ""
  myWordPrev = myWord
  '
  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;"
  '
  Call EspRevizoKontrolo(myFlag, myWord, myItem, myCustomDic, myConn, myRecSet)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  myText = myItem
  Call EspizoAeiou("", "_", myWord)
  Call EspizoCghjsu("", "^", myWord)
  Call EspizoUcOthers(myWord)
  '
  On Error Resume Next
  myConn.Close
  CommandBars(mySubName).Delete
  On Error GoTo 0
  '
  Set myCmmdBar = CommandBars.Add(Name:=mySubName, Position:=msoBarPopup, Temporary:=True)
  Set myCtrlBttn = myCmmdBar.Controls.Add(Type:=msoControlButton, Before:=1, Temporary:=True)
  Set myCtrlBttnOk = myCmmdBar.Controls.Add(Type:=msoControlButton, Before:=2, Temporary:=True)
  '
  If myFlag = True Then
    myText = Replace(myText, ";", ";" & vbCrLf)
    myMsg = myWord & vbCrLf & vbCrLf & myText & vbCrLf
    '
    With myCtrlBttn
      .DescriptionText = "[訳語の表示]処理後ポップアップメニュー"
      .Style = msoButtonIconAndCaption
      .Caption = myTitle & ":" & "[訳語の表示]" & Space(30)
      .TooltipText = "[訳語の表示]を実行しました。"
      .FaceId = 2922
      .OnAction = "EspRevizoBttnMyOk"
      myFaceId = .FaceId
    End With
    '
    With myCtrlBttnOk
      .DescriptionText = "[訳語の表示]処理:[OK]ボタン"
      .BeginGroup = True
      .Style = msoButtonIconAndWrapCaption
      .Caption = myMsg
      .TooltipText = "訳語を表示しました。"
      .FaceId = 1087
      .OnAction = "EspRevizoBttnMyOk"
    End With
  Else
    myMsg = "選択した単語が、辞書にありません。" & vbCrLf & vbCrLf & myWordPrev
    '
    With myCtrlBttn
      .DescriptionText = "[訳語の表示]処理後ポップアップメニュー"
      .Style = msoButtonIconAndCaption
      .Caption = myTitle & ":" & "[訳語の表示]" & Space(20)
      .TooltipText = "[訳語の表示]を実行しました。"
      .FaceId = 1019
      .OnAction = "EspRevizoBttnMyOk"
      myFaceId = .FaceId
    End With
    '
    With myCtrlBttnOk
      .DescriptionText = "[訳語の表示]処理:[OK]ボタン"
      .BeginGroup = True
      .Style = msoButtonIconAndWrapCaption
      .Caption = myMsg
      .TooltipText = "選択した単語が、辞書にありません。"
      .FaceId = 1088
      .OnAction = "EspRevizoBttnMyOk"
    End With
  End If
  '
  CommandBars(myTitle).Controls(1).FaceId = myFaceId
  Do
    On Error Resume Next
    myCmmdBar.ShowPopup
    On Error GoTo 0
    DoEvents
    If CommandBars(myTitle).Controls(1).FaceId <> myFaceId Then Exit Do
  Loop
  '
  On Error Resume Next
  myCmmdBar.Delete
  CommandBars(myTitle).Controls(1).FaceId = 2533
  On Error GoTo 0
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  If Not Selection.Range.Characters.Last.Next Is Nothing Then
    Select Case Selection.Range.Characters.Last.Next.Text
      Case ".", ",", ":", ";"
        Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    End Select
  End If
  '
  ' Selection.Collapse wdCollapseStart
  Selection.MoveRight Unit:=wdWord, Count:=1, Extend:=wdMove
  '
  Set myCmmdBar = Nothing
  Set myCtrlBttn = Nothing
  Set myCtrlBttnOk = Nothing
  '
  Set myConn = Nothing
  Set myRecSet = Nothing
End Sub ' EspRevizoPopItem *----*----*    *----*----*    *----*----*    *----*----*

Sub EspRevizoKontrolo(myFlag As Boolean, myWord As String, myItem As String, myCustomDic As String, myConn As Object, myRecSet As Object)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem 単語の検査
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Dim myWordPrev As String
  Dim myWordPrev2 As String
  Dim myFlagNext As String
  Dim myWordNext As String
  Dim myItemNext As String
  '
  Dim myLenPrev As Long
  Dim myLenDiff As Long
  '
  Dim i As Long
  Dim myHighlightColor As String
  Dim myCount As Long
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Rem 屈音符付き母音字を「_」付き代用文字に置換。
  Rem エスペラント語正書文字を「^」付き代用文字に置換。
  myWord = Trim(myWord)
  myLenPrev = Len(myWord)
  Call EspizoRvAeiou("", "_", myWord)
  Call EspizoRvCghjsu("", "^", myWord)
  Call EspizoRvOthers(myWord)
  myWord = Replace(myWord, "'", ChrW(8217)) ' ChrW(39)(Apostrophe)対策(異常終了の予防)。
  '
  myLenDiff = Len(myWord) - myLenPrev ' 代用文字表記で増えた文字数を計算する。
  myWordPrev = myWord
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Rem 三点リーダーに対応。
  If myWord Like "*..." Then
    myWord = Left(myWord, Len(myWord) - 2)
  End If
  '
  Rem 辞書を参照して、単語を検索する。
  Rem (1) そのまま辞書を参照。
  Call EspRevizoFleksio(myWord, myItem, myFlag, myLenDiff, myConn, myRecSet)
  '
  If myFlag = True Then Exit Sub
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Rem (2) 単語の末尾に終止符がある場合、終止符を除外して辞書を参照。
  If Right(myWord, 1) = "." Then
    Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    myWord = Left(myWord, Len(myWord) - 1)
    Call EspRevizoFleksio(myWord, myItem, myFlag, myLenDiff, myConn, myRecSet)
  End If
  '
  If myFlag = True Then Exit Sub
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Rem (3) 連結した複数単語の場合は、単一の単語ごとに辞書を参照。
  If Selection.Range.Words.Count > 1 Then
    myWordNext = ""
    myItemNext = ""
    myFlagNext = ""
    '
    For i = 1 To Selection.Range.Words.Count
      myFlag = False
      myWord = Selection.Range.Words.Item(i).Text
      myWordPrev2 = Trim(myWord)
      myWord = Trim(myWord)
      '
      If i >= Selection.Range.Words.Count Then
        Rem "-[接尾辞]に対応。"
        If Selection.Range.Words.Item(i).Previous.Text = "-" Then
          Select Case Trim(myWord)
            Case "a", "o", "j", "n", "e", "aj", "an", "en", "oj", "on", "ojn", "ajn"
              myWord = "-" & myWord
            Case "is", "as", "os", "us", "u", "i"
              myWord = "-" & myWord
          End Select
        End If
      Else
        If Selection.Range.Words.Item(i).Next.Text = "-" Then
          Select Case LCase(myWord)
            Case "re" ' 「re-」の検出。
              myWord = myWord & "-"
          End Select
        End If
      End If
      '
      myLenPrev = Len(myWord)
      Call EspizoRvAeiou("", "_", myWord)
      Call EspizoRvCghjsu("", "^", myWord)
      Call EspizoRvOthers(myWord)
      myLenDiff = Len(myWord) - myLenPrev ' 代用文字表記で増えた文字数を計算する。
      '
      Call EspRevizoFleksio(myWord, myItem, myFlag, myLenDiff, myConn, myRecSet)
      If myFlag = False Then
        If CommandBars("EspRevizo").Controls(4).FaceId = 4031 Then ' .TooltipText = "Officeの辞書も使用する。"
          If Val(Application.Version) >= 14 Then
            If Application.CheckSpelling(myWordPrev2, myCustomDic, False) = True Then
              Rem 参照先:"C:\Users\XXXXX\AppData\Roaming\Microsoft\UProof\CUSTOM.DIC"
              Rem Application.CustomDictionaries.ActiveCustomDictionary.Path
              myFlag = True
              myItem = "<mso>"
            End If
          Else
            If Application.CheckSpelling(myWordPrev2, "CUSTOM.DIC", False) = True Then
              Rem 辞書2を指定する場合:(myWordPrev2, "CUSTOM.DIC", False, , "myCustom2.DIC")
              myFlag = True
              myItem = "<mso>"
            End If
          End If
        End If
        If myFlag = False Then
          myFlagNext = myFlagNext & "False"
        End If
      End If
      myWordNext = myWordNext & myWord & vbCr
      myItemNext = myItemNext & myItem & vbCr
    Next ' i
    myWord = myWordNext
    myItem = myItemNext
    '
    Rem 連結した単語で、一つでも辞書にない場合は、
    Rem 辞書にない単語と見なす。
    If myFlagNext = "" Then
      myFlag = True
    Else
      myFlag = False
    End If
    '
    If myFlag = True Then Exit Sub
  End If
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Rem (4) その他単語校正(メイン辞書・既存ユーザー辞書を参照)。
  If CommandBars("EspRevizo").Controls(4).FaceId = 4031 Then ' .TooltipText = "Officeの辞書も使用する。"
    If Val(Application.Version) >= 14 Then
      If Application.CheckSpelling(myWordPrev, myCustomDic, False) = True Then
        myFlag = True
        myWord = myWordPrev
        myItem = "<mso>"
      End If
    Else
      If Application.CheckSpelling(myWordPrev, "CUSTOM.DIC", False) = True Then
        Rem 辞書2を指定する場合:(myWordPrev, "CUSTOM.DIC", False, , "myCustom2.DIC")
        myFlag = True
        myWord = myWordPrev
        myItem = "<mso>"
      End If
    End If
  End If
End Sub ' EspRevizoKontrolo *----*----*    *----*----*    *----*----*    *----*----*

Sub EspRevizoFleksio(myWord As String, myItem As String, myFlag As Boolean, myLenDiff As Long, myConn As Object, myRecSet As Object)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem エスペラント単語の屈折に対処する。
  Rem 名詞・形容詞の変化(deklinacio)/動詞の語尾変化(konjugacio)に対処。
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Dim myWordLCase As String
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  myItem = "?"
  '
  Select Case myWord
    Case "." ' 「.」の検出。
      myFlag = True
      myItem = ""
      Exit Sub
    Case "-" ' 「-」の検出。
      myFlag = True
      myItem = "-"
      Exit Sub
  End Select
  '
  myWordLCase = LCase(myWord)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Select Case myWordLCase
    'Case "mi", "vi", "li", "s^i", "g^i", "ni", "ili", "si", "oni"
    '  myWord = myWordLCase
    '
    ' Case "tio", "tiu", "tia", "tie", "ties", "tiel", "tiom", "tial", "tiam"
    '   myWord = myWordLCase
    ' Case "kio", "kiu", "kia", "kie", "kies", "kiel", "kiom", "kial", "kiam"
    '   myWord = myWordLCase
    ' Case "io", "iu", "ia", "ie", "ies", "iel", "iom", "ial", "iam"
    '   myWord = myWordLCase
    ' Case "c^io", "c^iu", "c^ia", "c^ie", "c^ies", "c^iel", "c^iom", "c^ial", "c^iam"
    '   myWord = myWordLCase
    ' Case "nenio", "neniu", "nenia", "nenie", "nenies", "neniel", "neniom", "nenial", "neniam"
    '   myWord = myWordLCase
    '
    Case "min", "vin", "lin", "s^in", "g^in", "nin", "ilin", "sin", "onin"
      myWord = Left(myWordLCase, Len(myWord) - 1)
    Case "miaj", "viaj", "liaj", "s^iaj", "g^iaj", "niaj", "iliaj", "siaj", "oniaj"
      myWord = Left(myWordLCase, Len(myWord) - 1)
    Case "mian", "vian", "lian", "s^ian", "g^ian", "nian", "ilian", "sian", "onian"
      myWord = Left(myWordLCase, Len(myWord) - 1)
    Case "miajn", "viajn", "liajn", "s^iajn", "g^iajn", "niajn", "iliajn", "siajn", "oniajn"
      myWord = Left(myWordLCase, Len(myWord) - 2)
    '
    Case "c^iuj", "tien", "kien", "ien", "c^ien"
      myWord = myWordLCase
    Case "c^iujn", "plurajn"
      myWord = Left(myWordLCase, Len(myWord) - 1)
    '
    Case "tion", "tiun", "tian", "tien", "kion", "kiun", "kian", "kien", "ion", "iun", "ian", "ien"
      myWord = Left(myWordLCase, Len(myWord) - 1)
    Case "c^ion", "c^iun", "c^ian", "c^ien", "nenion", "neniun", "nenian", "nenien"
      myWord = Left(myWordLCase, Len(myWord) - 1)
    '
    Case "tiuj", "tiaj", "kiuj", "kiaj", "iuj", "iaj", "c^iuj", "c^iaj", "neniuj", "neniaj"
      myWord = Left(myWordLCase, Len(myWord) - 1)
    '
    Case "tiujn", "tiajn", "kiujn", "kiajn", "iujn", "iajn", "c^iujn", "c^iajn", "neniujn", "neniajn"
      myWord = Left(myWordLCase, Len(myWord) - 2)
    '
    Rem あり得ない語形
    Case "tioj", "kioj", "ioj", "c^ioj", "nenioj", "tiojn", "kiojn", "iojn", "c^iojn", "neniojn", "plura"
      Exit Sub
    '
    Rem その他
    ' Case "ajn", "unu", "plus", "minus", "tamen", "jen", "elen", "pluen", "j^us"
    '   myWord = myWordLCase
    ' Case "hu", "ju", "nu", "bis", "cis", "g^is", "tuj", "ekde", "disde"
    '   myWord = myWordLCase
  End Select
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Call EspRevizoDicKey(myFlag, myWord, myItem, myConn, myRecSet)
  '
  Select Case True
    Case myFlag = True
      Exit Sub
    Case Right(myWord, 1) = "."
      Exit Sub
    Case (Len(myWord) - myLenDiff) <= 2
      Exit Sub
  End Select
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  If (Len(myWord) - myLenDiff) >= 4 Then
    Rem 冠詞語尾省略形
    Select Case Left(myWord, 2)
      Case "L" & ChrW(Val("&h0027")), "L" & ChrW(Val("&h2019"))
        myWord = Mid(myWord, 3)
      Case "l" & ChrW(Val("&h0027")), "l" & ChrW(Val("&h2019"))
        myWord = Mid(myWord, 3)
    End Select
  End If
  '
  If (Len(myWord) - myLenDiff) >= 3 Then
    Rem 名詞語尾省略形
    Select Case Right(myWord, 1)
      Case ChrW(Val("&h0027")), ChrW(Val("&h2019"))  ' 単一引用符
        myWord = Left(myWord, Len(myWord) - 1) & "o"
        GoTo EspRevizoFleksioSubEntry
    End Select
  End If
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  If (Len(myWord) - myLenDiff) >= 5 Then
    Rem 複数形-対格
    Select Case Right(myWord, 3)
      Case "ajn"
        myWord = Left(myWord, Len(myWord) - 2)
        GoTo EspRevizoFleksioSubEntry
      Case "ojn"
        myWord = Left(myWord, Len(myWord) - 2)
        GoTo EspRevizoFleksioSubEntry
    End Select
  End If
  '
  If (Len(myWord) - myLenDiff) >= 4 Then
    Rem 複数形-主格/単数形-対格/動詞語尾・対格副詞
    Select Case Right(myWord, 2)
      Case "oj"
        myWord = Left(myWord, Len(myWord) - 1)
        GoTo EspRevizoFleksioSubEntry
      Case "on"
        myWord = Left(myWord, Len(myWord) - 1)
        GoTo EspRevizoFleksioSubEntry
      Case "aj"
        myWord = Left(myWord, Len(myWord) - 1)
        GoTo EspRevizoFleksioSubEntry
      Case "an"
        myWord = Left(myWord, Len(myWord) - 1)
        GoTo EspRevizoFleksioSubEntry
      Case "is", "as", "os", "us"
        myWord = Left(myWord, Len(myWord) - 2) & "i"
        GoTo EspRevizoFleksioSubEntry
      Case "en"
        myWord = Left(myWord, Len(myWord) - 2) & "e"
        GoTo EspRevizoFleksioSubEntry
    End Select
  End If
  '
  Rem 副詞・命令形-動詞
  If (Len(myWord) - myLenDiff) >= 3 Then
    Select Case Right(myWord, 1)
      Case "e"
        myWord = Left(myWord, Len(myWord) - 1) & "a"
        GoTo EspRevizoFleksioSubEntry
      Case "u"
        myWord = Left(myWord, Len(myWord) - 1) & "i"
        GoTo EspRevizoFleksioSubEntry
    End Select
  End If
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
EspRevizoFleksioSubEntry:
  Call EspRevizoDicKey(myFlag, myWord, myItem, myConn, myRecSet)
  If myFlag = True Then Exit Sub
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  If Right(myWord, 1) = "a" Then
    myWord = Left(myWord, Len(myWord) - 1) & "i"
    Call EspRevizoDicKey(myFlag, myWord, myItem, myConn, myRecSet)
    If myFlag = True Then Exit Sub
    '
    myWord = Left(myWord, Len(myWord) - 1) & "o"
    Call EspRevizoDicKey(myFlag, myWord, myItem, myConn, myRecSet)
    If myFlag = True Then Exit Sub
    '
    myWord = Left(myWord, Len(myWord) - 1) & "a"
  End If
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  If (Len(myWord) - myLenDiff) >= 5 Then
    Rem 受動分詞・抽象名詞・動詞語根名詞
    Select Case Right(myWord, 3)
      Case "ita", "ata", "ota"
        myWord = Left(myWord, Len(myWord) - 3) & "i"
        GoTo EspRevizoFleksioSubExit
      Case "eco"
        myWord = Left(myWord, Len(myWord) - 3) & "a"
        GoTo EspRevizoFleksioSubExit
      Case "ado"
        myWord = Left(myWord, Len(myWord) - 3) & "i"
        GoTo EspRevizoFleksioSubExit
    End Select
  End If
  '
  Rem 能動分詞
  If (Len(myWord) - myLenDiff) >= 6 Then
    Select Case Right(myWord, 4)
      Case "inta", "anta", "onta"
        myWord = Left(myWord, Len(myWord) - 4) & "i"
        GoTo EspRevizoFleksioSubExit
    End Select
  End If
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
EspRevizoFleksioSubExit:
  Call EspRevizoDicKey(myFlag, myWord, myItem, myConn, myRecSet)
  If myFlag = True Then Exit Sub
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Exit Sub
  '
  Rem ↑取り敢えず、処理時間短縮を優先。後日の検討を要する。
  '
  Rem 品詞転換(形容詞/名詞/副詞)
  If (Len(myWord) - myLenDiff) >= 3 Then
    Select Case Right(myWord, 1)
      Case "a"
        myWord = Left(myWord, Len(myWord) - 1) & "o"
      Case "o"
        myWord = Left(myWord, Len(myWord) - 1) & "a"
      Case "e"
        myWord = Left(myWord, Len(myWord) - 1) & "a"
    End Select
  End If
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Call EspRevizoDicKey(myFlag, myWord, myItem, myConn, myRecSet)
End Sub ' EspRevizoFleksio *----*----*    *----*----*    *----*----*    *----*----*

Sub EspRevizoDicKey(myFlag As Boolean, myWord As String, myItem As String, myConn As Object, myRecSet As Object)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem 単語に関して、辞書を参照する。
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Dim DBPath As String
  Dim CsvDB As String
  Dim myDicPcase As String
  Dim myDicLcase As String
  Dim mySQL As String
  '
  Dim myFind As String
  Dim i As Long
  Dim j As Long
  Dim myValue As String
  Dim myItem2 As String
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Call EspRevizoConst("myFolder", DBPath)
  Call EspRevizoConst("myDicPejvo", CsvDB)
  Call EspRevizoConst("myDicPcase", myDicPcase)
  Call EspRevizoConst("myDicLcase", myDicLcase)
  '
  myFind = myWord
  myFind = Replace(myFind, "^", "[^]")
  myFind = Replace(myFind, "_", "[_]")
  '
  mySQL = "Select  訳語  From  " & CsvDB & "  "
  mySQL = mySQL & "Where 単語 Like '" & myFind & "'  "
  mySQL = mySQL & "  Union All  "
  mySQL = mySQL & "Select  訳語  From  " & myDicPcase & "  "
  mySQL = mySQL & "Where 単語 Like '" & myFind & "'  "
  mySQL = mySQL & "  Union All  "
  mySQL = mySQL & "Select  訳語  From  " & myDicLcase & "  "
  mySQL = mySQL & "Where 単語 Like '" & myFind & "';  "
  '
  Set myRecSet = myConn.Execute(mySQL)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Rem フィールド名を転記
  'For i = 1 To myRecSet.Fields.Count
  '  Selection.TypeText Text:=myRecSet.Fields(i - 1).Name & " "
  'Next ' i
  '
  j = 0
  myItem = ""
  Rem レコードを転記
  Do While Not myRecSet.EOF
    myItem2 = ""
    For i = 1 To myRecSet.Fields.Count
      myValue = myRecSet.Fields(i - 1).Value
      Call EspizoAeiou("", "_", myValue)
      Call EspizoCghjsu("", "^", myValue)
      Call EspizoUcOthers(myValue)
      myItem2 = myItem2 & myValue & " "
    Next ' i
    '
    j = j + 1
    myItem = myItem & myItem2 & vbCrLf
    myRecSet.MoveNext
  Loop
  '
  If j > 0 Then
    myFlag = True
    Call EspRevizoDicItem(myWord, myItem)
    Exit Sub
  End If
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Select Case Left(myWord, 1)
    Case "A" To "Z"
      myFind = LCase(myWord)
      myFind = Replace(myFind, "^", "[^]")
      myFind = Replace(myFind, "_", "[_]")
      '
      mySQL = "Select  訳語  From  " & CsvDB & "  "
      mySQL = mySQL & "Where 単語 Like '" & myFind & "'  "
      mySQL = mySQL & "  Union All  "
      mySQL = mySQL & "Select  訳語  From  " & myDicPcase & "  "
      mySQL = mySQL & "Where 単語 Like '" & myFind & "'  "
      mySQL = mySQL & "  Union All  "
      mySQL = mySQL & "Select  訳語  From  " & myDicLcase & "  "
      mySQL = mySQL & "Where 単語 Like '" & myFind & "';  "
      '
      Set myRecSet = myConn.Execute(mySQL)
      '
      j = 0
      myItem = ""
      Rem レコードを転記
      Do While Not myRecSet.EOF
        myItem2 = ""
        For i = 1 To myRecSet.Fields.Count
          myValue = myRecSet.Fields(i - 1).Value
          Call EspizoAeiou("", "_", myValue)
          Call EspizoCghjsu("", "^", myValue)
          Call EspizoUcOthers(myValue)
          myItem2 = myItem2 & myValue & " "
        Next ' i
        '
        j = j + 1
        myItem = myItem & myItem2 & vbCrLf
        myRecSet.MoveNext
      Loop
      '
      If j > 0 Then
        myFlag = True
        myWord = LCase(myWord)
        Call EspRevizoDicItem(myWord, myItem)
        Exit Sub
      End If
  End Select
End Sub ' EspRevizoDicKey *----*----*    *----*----*    *----*----*    *----*----*

Sub EspRevizoDicItem(myWord As String, myItem As String)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem 特定の単語に関して、辞書の訳語を置換する。
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Select Case LCase(myWord)
    Case "g^i"
      myItem = "それ[中性]"
    Case "ili"
      myItem = "[三・複]"
    Case "sia"
      myItem = "自身の"
    Case "c^i"
      myItem = "[近接]"
    Case "la"
      myItem = "冠詞"
    ' Case "re-"
    '   myItem = "[再び・元へ]"
    Case "je"
      myItem = "[〜に]"
    Case "povi"
      myItem = "<他>できる/かも知れない"
    Case "ne"
      myItem = "[否定]"
    Case "de"
      myItem = "〜の/から/によって"
  End Select
End Sub ' EspRevizoDicItem *----*----*    *----*----*    *----*----*    *----*----*

Sub EspRevizoPhGuide(myItem As String)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem 訳語ルビ設定
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  If Trim(myItem) = "" Then Exit Sub
  If Trim(myItem) = "-" Then Exit Sub
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  myItem = Replace(myItem, "<B>", "")
  myItem = Replace(myItem, "<O>", "")
  myItem = Replace(myItem, "<代>", "")
  myItem = Replace(myItem, "<前>", "")
  myItem = Replace(myItem, "<接>", "")
  myItem = Replace(myItem, ",", " ")
  myItem = Replace(myItem, vbCrLf, "")
  '
  With Selection
    .Range.PhoneticGuide Text:=myItem, Alignment:=wdPhoneticGuideAlignmentCenter, _
     Raise:=9, FontSize:=4, FontName:="MS UI Gothic"
    ' .Fields(1).ShowCodes = False
    .SetRange Start:=.Start, End:=.End
    .Collapse wdCollapseEnd
  End With
End Sub ' EspRevizoPhGuide *----*----*    *----*----*    *----*----*    *----*----*

Sub EspRevizoDicSelect(myFolder As String, myDicName As String, myHighlightColor As String, myCount As Long)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem 辞書に登録する単語(蛍光ペン書式の文字列)を検索
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Dim myDicPcase As String
  Dim myFullName As String
  Dim myDocOne As Document
  Dim myDocNew As Document
  Dim myDocDic As Document
  '
  Dim myStartMarker As Word.Range
  Dim myPara As Paragraph
  Dim myWord As String
  Dim myPrevWord As String
  Dim myText As String
  Dim myAbbr As String
  '
  Dim myStatusBar As String
  Dim myTitle As String
  Dim myMsg As String
  Dim myAns As Long
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Application.ScreenUpdating = False
  '
  Call EspRevizoConst("myAbbr", myAbbr)
  Call EspRevizoConst("myDicPcase", myDicPcase)
  Rem 書き出し先の辞書。
  myFullName = myFolder & "\" & myDicName
  '
  Set myDocOne = ActiveDocument
  Rem 作業用の文書を新規作成する。
  Set myDocNew = Documents.Add
  myDocOne.Activate
  '
  Rem 検索開始点の取得。(読み込み元の文書)
  Selection.Collapse wdCollapseStart
  Set myStartMarker = Selection.Range
  '
  Rem 蛍光ペン書式を検索。
  With Selection.Find
    .ClearFormatting
    .Highlight = True ' 蛍光ペンを検索することを指定
    .Text = ""
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
  End With
  '
  'myStatusBar = "辞書に登録する単語を文書から取り出します。"
  'Application.StatusBar = myTitle & ":処理中" & " " & myStatusBar
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
EspRevizoDicSelectSubEntry:
  Rem 検索を実行。
  Do While Selection.Find.Execute
    If Selection.Range.HighlightColorIndex = myHighlightColor Then
      Rem ルビなどのフィールドが設定されている場合は、フィールドを解除する。
      If AscW(Selection.Range.Words.Item(1).Text) = 21 Then
        With Selection
          .Start = .Range.Characters.First.Start
          .End = .Range.Characters.Last.End
          .Range.PhoneticGuide Text:="", Alignment:=wdPhoneticGuideAlignmentCenter, _
           Raise:=9, FontSize:=5, FontName:="MS UI Gothic"
        End With
      End If
      Rem *----*----*    *----*----*
      '
      Rem 空文字を範囲選択することがあるので、この場合は、処理を避ける。
      If Selection.Range.Text <> "" Then
        If Selection.Range.Text = vbCr Then Exit Do ' 文書末尾にカーソルがある場合の対策。
        myWord = Replace(myWord, vbCr, "") ' 文末に文字列があった場合の対策。
        Rem *----*----*    *----*----*
        '
        Rem 屈音符付き母音字を「_」付き代用文字に置換。
        Rem エスペラント語正書文字を「^」付き代用文字に置換。
        myWord = Trim(Selection.Range.Text)
        Call EspizoRvAeiou("", "_", myWord)
        Call EspizoRvCghjsu("", "^", myWord)
        Call EspizoRvOthers(myWord)
        Rem *----*----*    *----*----*
        '
        myDocNew.Activate
        Selection.TypeText Text:=myWord & vbCrLf
        myCount = myCount + 1
        myDocOne.Activate
      End If
    End If
    '
    Selection.Collapse wdCollapseEnd
  Loop
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  If myCount = 0 Then
    myDocNew.Close SaveChanges:=wdDoNotSaveChanges
    Application.ScreenUpdating = True
    '
    Rem 検索開始点に戻る。(読み込み元の文書)
    myStartMarker.Select
    '
    GoTo EspRevizoDicSelectSubExit
  End If
  '
  Rem 検索開始点に戻る。(読み込み元の文書)
  myStartMarker.Select
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Rem 作業用の文書で取り出した単語を並び替える。
  myDocNew.Activate
  Rem 文書末尾の改行を削る。
  With Selection
    .EndKey Unit:=wdStory, Extend:=wdMove
    .TypeBackspace
  End With
  '
  myStatusBar = "取り出した単語を昇順に並び替えします。"
  Application.StatusBar = myTitle & ":処理中" & " " & myStatusBar
  '
  Rem 昇順に並べ替え。
  Selection.WholeStory ' すべて選択。
  On Error Resume Next ' 辞書に登録する単語が1件以下の場合に備える。
  Selection.Sort ExcludeHeader:=False, FieldNumber:="段落", _
    SortFieldType:=wdSortFieldJapanJIS, SortOrder:=wdSortOrderAscending, _
    LanguageID:=wdJapanese
  Selection.HomeKey Unit:=wdStory, Extend:=wdMove
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Rem 辞書を開く。
  Documents.Open FileName:=myFullName, Format:=wdOpenFormatText, AddToRecentFiles:=False
  Documents(myDicName).Activate
  Selection.EndKey Unit:=wdStory, Extend:=wdMove
  Selection.TypeParagraph
  Rem 単語追加の開始点の取得。(辞書)
  Set myStartMarker = Selection.Range
  '
  myStatusBar = "単語を辞書に追加する準備をします。"
  myStatusBar = myStatusBar & "( " & myDicName & " )"
  Application.StatusBar = myTitle & ":処理中" & " " & myStatusBar
  '
  If myDicName = myDicPcase Then
    myText = "[社駅店商標地域路線名]" & myAbbr
  Else
    myText = "[自他形副代前接間擬略N]" & myAbbr
  End If
  Rem 辞書に登録する単語を追加する。
  Rem 重複する単語は除外する。
  myCount = 0
  myPrevWord = ""
  For Each myPara In myDocNew.Paragraphs
    myDocNew.Activate
    If myPara.Range.Text <> myPrevWord Then
      myWord = Left(myPara.Range.Text, Len(myPara.Range.Text) - 1)
      Documents(myDicName).Activate
      If myDicName = myDicPcase Then
        With Selection
          .Font.Color = wdColorRed
          .TypeText Text:=myWord
          .Font.Color = wdColorSkyBlue
          .TypeText Text:=":"
          .Font.Color = wdColorAutomatic
          .TypeText Text:=myText & vbCrLf
        End With
        myCount = myCount + 1
      Else
        With Selection
          .Font.Color = wdColorRed
          .TypeText Text:=myWord
          .Font.Color = wdColorSkyBlue
          .TypeText Text:=":"
          .Font.Color = wdColorAutomatic
          .TypeText Text:=myText & vbCrLf
        End With
        myCount = myCount + 1
      End If
    End If
    myPrevWord = myPara.Range.Text
  Next myPara
  '
  Rem 作業用の文書を閉じる。
  myDocNew.Close SaveChanges:=wdDoNotSaveChanges
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Application.ScreenUpdating = True
  '
  Documents(myDicName).Activate
  Selection.TypeBackspace
  Rem 単語追加の開始点に戻る。(辞書)
  myStartMarker.Select
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
EspRevizoDicSelectSubExit:
  Set myDocOne = Nothing
  Set myDocNew = Nothing
  Set myStartMarker = Nothing
End Sub ' EspRevizoDicSelect *----*----*    *----*----*    *----*----*    *----*----*

Sub EspRevizoConst(myFlag As String, myConst As String)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem 定数設定処理
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Dim myTitle As String
  Dim myDicPejvo As String
  Dim myDicPcase As String
  Dim myDicLcase As String
  Dim myMsg As String
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Rem マクロ名。
  myTitle = "EspRevizo"
  '
  Rem 関連ファイル名。
  myDicPejvo = "pejvo_s.txt"
  myDicPcase = "EspRevizoPcase.csv"
  myDicLcase = "EspRevizoLcase.csv"
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Select Case myFlag
    Case "myTitle" ' マクロ名
      myConst = myTitle
    Case "myDicPejvo" ' エスペラント語辞典
      myConst = myDicPejvo
    Case "myDicPcase" ' 固有名詞辞書
      myConst = myDicPcase
    Case "myDicLcase" ' 小文字辞書
      myConst = myDicLcase
    Case "myAbbr" ' 専門分野略記号
      myConst = "【医】【E】【印】【運】【映】"
      myConst = myConst & "【園】【カ】【化】【果】【菓】"
      myConst = myConst & "【貨】【解】【海】【貝】【学】"
      myConst = myConst & "【楽】【環】【キ】【機】【気】"
      myConst = myConst & "【魚】【菌】【空】【軍】【経】"
      myConst = myConst & "【芸】【劇】【建】【古生】【古地名】"
      myConst = myConst & "【語】【光】【交】【鉱】【考古】"
      myConst = myConst & "【国名】【史】【G】【写】【車】"
      myConst = myConst & "【宗】【修】【商】【情】【植】"
      myConst = myConst & "【織】【心】【神】【人名】【数】"
      myConst = myConst & "【政】【聖】【生】【声】【単】"
      myConst = myConst & "【地質】【地名】【地理】【虫】【鳥】"
      myConst = myConst & "【通】【哲】【鉄】【天】【電】"
      myConst = myConst & "【統】【動】【日】【農】【馬】"
      myConst = myConst & "【美】【病】【服】【仏】【文】"
      myConst = myConst & "【法】【薬】【遊】【理】【料】"
      myConst = myConst & "【論】【イ】"
      myConst = myConst & "《転》《般》《稀》《詩》《廃》《古》"
    Case "myFolder", "AppData"
      GoTo EspRevizoConstSubEntry
    Case Else
      myMsg = "処理できません!" & vbCrLf
      myMsg = myMsg & "EspRevizoConst" & vbCrLf
      myMsg = myMsg & "myFlag" & "未対応:" & myFlag
      Call MsgBox(myMsg, vbOK + vbCritical + vbDefaultButton2, myTitle)
      Exit Sub
  End Select
  '
  Exit Sub
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
EspRevizoConstSubEntry:
  Dim myShell As Object ' IWshShell3
  Dim myFso As Object
  Dim myFile As Object
  '
  Dim myFolder As String
  Dim myFullName As String
  Dim myDicCount As Long
  '
  Dim myStatusBar As String
  '
  Set myShell = CreateObject("WScript.Shell")
  Set myFso = CreateObject("Scripting.FileSystemObject")
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Select Case myFlag
    Case "myFolder"
      Rem 関連ファイルの保存先フォルダ。
      myFolder = myShell.SpecialFolders("MyDocuments") ' マイドキュメント
      myFolder = myFolder & "\EspRevizo\PEJVO" ' マイドキュメント内のフォルダ指定
    Case "AppData"
      Rem アプリケーションデータ‐フォルダ。
      myFolder = myShell.SpecialFolders("AppData") ' アプリケーションデータ‐フォルダ
  End Select
  myConst = myFolder
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
EspRevizoConstSubExit:
  Set myShell = Nothing
  Set myFso = Nothing
  Set myFile = Nothing
End Sub ' EspRevizoConst *----*----*    *----*----*    *----*----*    *----*----*
inserted by FC2 system