Sub MyCsvLbox()
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem 選択文字列挿入処理（リストボックス三重連）
  Rem （コンマ区切り形式ファイル SQL文指定 データ参照処理）
  Rem 作譜：Hitrock Camellia Shinopy
  Rem 言語：Word VBA
  Rem 機能...
  Rem   1. リストボックス１から挿入したい文字列の分類を選択する。
  Rem   2. リストボックス２から文字列を選択して文書上に挿入する。
  Rem 注記...
  Rem   1. 「MyCsvLboxSchemaIni」を初回実行前に先行して一度だけ実行し、
  Rem      コンマ区切り形式ファイルの保存先フォルダ・「schema.ini」ファイル・CSVファイルを作成しておくこと。
  Rem      MyCsvLboxConst（既定値設定処理）で、保存先フォルダ名・CSVファイル名を指定する。（既定値は2・3の通り）
  Rem   2. 「DBPath」にコンマ区切り形式ファイルの保存先フォルダを指定すること。
  Rem      関連フォルダ名の既定値は、マイドキュメントの\MyCsvLboxフォルダ。
  Rem   3. 「CsvDB」にファイル名を指定すること。
  Rem      関連CSVファイル名の既定値は、MyCsvLbox.csv。
  Rem   4.「MyCsvLbox」を起動して、ツールバーを追加・表示しておき、使用する。
  Rem   5. マクロ実行時に画面表示が最大化の状態の場合、通常表示に変更する。（MyCsvLboxFullScreen）
  Rem   6. コンマ区切り形式ファイルを参照する部分を、下記の書籍から引用して、Word VBA用に改変した。
  Rem      小島政行『VisualBasic,VBA,VBScriptのための実践＆リファレンスADO』アプライドナレッジの
  Rem        「第3部 ADOの活用  第2章 VBA」
  Rem    　佐藤信正『VBScript実用プログラミング・テクニック』メディア・テック出版の
  Rem        「Part5 [16]12万件の郵便番号を検索する」
  Rem 履歴...
  Rem   第01版：2008/08/30：作成。
  Rem   第02版：2009/10/10：[次へ]ボタンを追加。
  Rem   第03版：2011/03/14：リストボックスを三重連に変更。
  Rem   第04版：2012/01/14：DimステートメントのVariantをObjectに変更。
  Rem   第05版：2013/08/30：[挿入][次へ]ボタンのポップヒント表示を追加。
  Rem   第06版：2013/09/22：Controls(1)をControls("Type")、Controls(4)をControls("Next")に変更。
  Rem   第07版：2014/02/02：半角括弧・全角括弧・引用符の場合、文書上の文字列を選択して文字を挿入した時に、
  Rem                       選択した文字列を括弧・引用符で挟んで挿入するように変更。
  Rem   第08版：2014/03/29：[次へ]ボタンのポップヒント表示を確実に表示するため、画面表示最大化時の対策。
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Dim myTitle As String
  Dim i As Long
  Dim j As Long
  Dim myValuePrev As String
  '
  Dim myConn As Object ' ADODB.Connection
  Dim myRecSet As Object ' ADODB.Recordset
  Dim DBPath As String
  Dim CsvDB As String
  Dim mySQL As String
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  myTitle = "MyCsvLbox"
  Call MyCsvLboxConst("myTitleNew", myTitle)
  Call MyCsvLboxConst("DBPath", DBPath)
  Call MyCsvLboxConst("CsvDB", CsvDB)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Call MyCsvLboxFullScreen ' [次へ]押下時にポップヒントを無理やり表示させるため。（苦肉の策！）
  Call MyCsvLboxCmmdBar(myTitle)
  '
  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 *----*----*    *----*----*    *----*----*    *----*----*
  '
MyCsvLboxSubEntry:
  Rem [分類]のデータを整列せず、リストボックス１に表示する場合
  mySQL = "SELECT  分類  FROM  " & CsvDB & ";"
  '
  Rem テーブルへの参照を取得
  With myRecSet
    .ActiveConnection = myConn
    .Source = mySQL
    .Open
  End With
  '
  i = 0
  myValuePrev = ""
  '
  If myRecSet.EOF Then
    MsgBox "[ " & CsvDB & " ]にデータがありません。 ", vbCritical
    GoTo MyCsvLboxSubExit
  End If
  '
  Rem レコードを転記
  Do While Not myRecSet.EOF
    If myRecSet.Fields(0).Value <> myValuePrev Then
      i = i + 1
      '
      For j = 1 To 3
        With CommandBars(myTitle & CStr(j)).Controls(2)
          .AddItem myRecSet.Fields(0).Value, i
          .DropDownLines = i
          .ListIndex = 0
          .Parameter = ""
        End With
      Next ' j
      '
      myValuePrev = myRecSet.Fields(0).Value
    End If
    myRecSet.MoveNext
  Loop
  '
  GoTo MyCsvLboxSubExit
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Rem [分類]のデータを整列して、リストボックス１に表示する場合
  mySQL = "SELECT  DISTINCT 分類  FROM  " & CsvDB & ";"
  ' mySQL = "SELECT  分類  FROM  " & CsvDB & "  GROUP  BY 分類;"
  '
  With myRecSet
    .ActiveConnection = myConn
    .Source = mySQL
    .Open
  End With
  '
  i = 0
  Do While Not myRecSet.EOF
    i = i + 1
    '
    For j = 1 To 3
      With CommandBars(myTitle & CStr(j)).Controls(2)
        .AddItem myRecSet.Fields(0).Value, i
        .DropDownLines = i
        .ListIndex = 0
        .Parameter = ""
      End With
    Next ' j
    '
    myRecSet.MoveNext
  Loop
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
MyCsvLboxSubExit:
  Rem 接続を閉じる
  On Error Resume Next
  myRecSet.Close
  myConn.Close
  On Error GoTo 0
  '
  Set myConn = Nothing
  Set myRecSet = Nothing
End Sub ' MyCsvLbox *----*----*    *----*----*    *----*----*    *----*----*

Sub MyCsvLboxCmmdBar(myTitle As String)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem コマンドバー設定処理
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Dim i As Long
  '
  Dim myCmmdBar1 As CommandBar
  Dim myCtrl1BttnType As CommandBarControl
  Dim myCtrl1DdwnOne As CommandBarControl
  Dim myCtrl1DdwnTwo As CommandBarControl
  Dim myCtrl1BttnNext As CommandBarControl
  '
  Dim myCmmdBar2 As CommandBar
  Dim myCtrl2BttnType As CommandBarControl
  Dim myCtrl2DdwnOne As CommandBarControl
  Dim myCtrl2DdwnTwo As CommandBarControl
  Dim myCtrl2BttnNext As CommandBarControl
  '
  Dim myCmmdBar3 As CommandBar
  Dim myCtrl3BttnType As CommandBarControl
  Dim myCtrl3DdwnOne As CommandBarControl
  Dim myCtrl3DdwnTwo As CommandBarControl
  Dim myCtrl3BttnNext As CommandBarControl
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  On Error Resume Next
  CommandBars(myTitle).Delete
  For i = 1 To 3
    CommandBars(myTitle & CStr(i)).Delete
  Next ' i
  On Error GoTo 0
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Set myCmmdBar1 = CommandBars.Add(Name:=myTitle & "1", Position:=msoBarTop, Temporary:=True)
  Set myCtrl1BttnType = myCmmdBar1.Controls.Add(Type:=msoControlButton, Before:=1, Temporary:=True)
  Set myCtrl1DdwnOne = myCmmdBar1.Controls.Add(Type:=msoControlDropdown, Before:=2, Temporary:=True)
  Set myCtrl1DdwnTwo = myCmmdBar1.Controls.Add(Type:=msoControlDropdown, Before:=3, Temporary:=True)
  Set myCtrl1BttnNext = myCmmdBar1.Controls.Add(Type:=msoControlButton, Before:=4, Temporary:=True)
  '
  Set myCmmdBar2 = CommandBars.Add(Name:=myTitle & "2", Position:=msoBarTop, Temporary:=True)
  Set myCtrl2BttnType = myCmmdBar2.Controls.Add(Type:=msoControlButton, Before:=1, Temporary:=True)
  Set myCtrl2DdwnOne = myCmmdBar2.Controls.Add(Type:=msoControlDropdown, Before:=2, Temporary:=True)
  Set myCtrl2DdwnTwo = myCmmdBar2.Controls.Add(Type:=msoControlDropdown, Before:=3, Temporary:=True)
  Set myCtrl2BttnNext = myCmmdBar2.Controls.Add(Type:=msoControlButton, Before:=4, Temporary:=True)
  '
  Set myCmmdBar3 = CommandBars.Add(Name:=myTitle & "3", Position:=msoBarTop, Temporary:=True)
  Set myCtrl3BttnType = myCmmdBar3.Controls.Add(Type:=msoControlButton, Before:=1, Temporary:=True)
  Set myCtrl3DdwnOne = myCmmdBar3.Controls.Add(Type:=msoControlDropdown, Before:=2, Temporary:=True)
  Set myCtrl3DdwnTwo = myCmmdBar3.Controls.Add(Type:=msoControlDropdown, Before:=3, Temporary:=True)
  Set myCtrl3BttnNext = myCmmdBar3.Controls.Add(Type:=msoControlButton, Before:=4, Temporary:=True)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  With myCtrl1BttnType
    .DescriptionText = "挿入ボタン"
    .Style = msoButtonIcon
    .Caption = "Type"
    .TooltipText = "文字列を挿入します。"
    .FaceId = 31
    .Parameter = ""
    .OnAction = myTitle & "1BttnType"
  End With
  '
  With myCtrl1DdwnOne
    .DescriptionText = "リストボックス１"
    .Style = msoComboNormal ' ラベルテキストを表示しない。
    .Caption = ""
    .TooltipText = "挿入したい文字列の分類を選択して下さい。"
    .BeginGroup = True
    .DropDownWidth = 400
    .OnAction = myTitle & "1DdwnOne"
  End With
  '
  With myCtrl1DdwnTwo
    .DescriptionText = "リストボックス２"
    .Style = msoComboNormal
    .Caption = ""
    .TooltipText = "選択した文字列を挿入します。"
    .BeginGroup = True
    .DropDownWidth = 400
    .OnAction = myTitle & "1DdwnTwo"
  End With
  '
  With myCtrl1BttnNext
    .DescriptionText = "次へボタン"
    .Style = msoButtonIcon
    .Caption = "Next"
    .TooltipText = "次の文字列を挿入します。"
    .FaceId = 157
    .Parameter = ""
    .OnAction = myTitle & "1BttnNext"
  End With
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  With myCtrl2BttnType
    .DescriptionText = "挿入ボタン"
    .Style = msoButtonIcon
    .Caption = "Type"
    .TooltipText = "文字列を挿入します。"
    .FaceId = 31
    .Parameter = ""
    .OnAction = myTitle & "2BttnType"
  End With
  '
  With myCtrl2DdwnOne
    .DescriptionText = "リストボックス１"
    .Style = msoComboNormal
    .Caption = ""
    .TooltipText = "挿入したい文字列の分類を選択して下さい。"
    .BeginGroup = True
    .DropDownWidth = 400
    .OnAction = myTitle & "2DdwnOne"
  End With
  '
  With myCtrl2DdwnTwo
    .DescriptionText = "リストボックス２"
    .Style = msoComboNormal
    .Caption = ""
    .TooltipText = "選択した文字列を挿入します。"
    .BeginGroup = True
    .DropDownWidth = 400
    .OnAction = myTitle & "2DdwnTwo"
  End With
  '
  With myCtrl2BttnNext
    .DescriptionText = "次へボタン"
    .Style = msoButtonIcon
    .Caption = "Next"
    .TooltipText = "次の文字列を挿入します。"
    .FaceId = 157
    .Parameter = ""
    .OnAction = myTitle & "2BttnNext"
  End With
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  With myCtrl3BttnType
    .DescriptionText = "挿入ボタン"
    .Style = msoButtonIcon
    .Caption = "Type"
    .TooltipText = "文字列を挿入します。"
    .FaceId = 31
    .Parameter = ""
    .OnAction = myTitle & "3BttnType"
  End With
  '
  With myCtrl3DdwnOne
    .DescriptionText = "リストボックス１"
    .Style = msoComboNormal
    .Caption = ""
    .TooltipText = "挿入したい文字列の分類を選択して下さい。"
    .BeginGroup = True
    .DropDownWidth = 400
    .OnAction = myTitle & "3DdwnOne"
  End With
  '
  With myCtrl3DdwnTwo
    .DescriptionText = "リストボックス２"
    .Style = msoComboNormal
    .Caption = ""
    .TooltipText = "選択した文字列を挿入します。"
    .BeginGroup = True
    .DropDownWidth = 400
    .OnAction = myTitle & "3DdwnTwo"
  End With
  '
  With myCtrl3BttnNext
    .DescriptionText = "次へボタン"
    .Style = msoButtonIcon
    .Caption = "Next"
    .TooltipText = "次の文字列を挿入します。"
    .FaceId = 157
    .Parameter = ""
    .OnAction = myTitle & "3BttnNext"
  End With
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  For i = 1 To 3
    CommandBars(myTitle & CStr(i)).Controls("Type").Enabled = False
    CommandBars(myTitle & CStr(i)).Controls("Next").Enabled = False
    CommandBars(myTitle & CStr(i)).Visible = True
  Next ' i
End Sub ' MyCsvLboxCmmdBar *----*----*    *----*----*    *----*----*    *----*----*

Sub MyCsvLbox1BttnType(Optional myDummy As Boolean)
  Dim myTitle As String
  Call MyCsvLboxConst("myTitle", myTitle)
  Call MyCsvLboxConst("myCmmdBarNumber", myTitle & "1")
  Call MyCsvLboxBttnType
End Sub ' MyCsvLbox1BttnType *----*----*    *----*----*    *----*----*    *----*----*

Sub MyCsvLbox1DdwnOne(Optional myDummy As Boolean)
  Dim myTitle As String
  Call MyCsvLboxConst("myTitle", myTitle)
  Call MyCsvLboxConst("myCmmdBarNumber", myTitle & "1")
  Call MyCsvLboxDdwnOne
End Sub ' MyCsvLbox1DdwnOne *----*----*    *----*----*    *----*----*    *----*----*

Sub MyCsvLbox1DdwnTwo(Optional myDummy As Boolean)
  Dim myTitle As String
  Call MyCsvLboxConst("myTitle", myTitle)
  Call MyCsvLboxConst("myCmmdBarNumber", myTitle & "1")
  Call MyCsvLboxDdwnTwo
End Sub ' MyCsvLbox1DdwnTwo *----*----*    *----*----*    *----*----*    *----*----*

Sub MyCsvLbox1BttnNext(Optional myDummy As Boolean)
  Dim myTitle As String
  Call MyCsvLboxConst("myTitle", myTitle)
  Call MyCsvLboxConst("myCmmdBarNumber", myTitle & "1")
  Call MyCsvLboxBttnNext
End Sub ' MyCsvLbox1BttnNext *----*----*    *----*----*    *----*----*    *----*----*

Sub MyCsvLbox2BttnType(Optional myDummy As Boolean)
  Dim myTitle As String
  Call MyCsvLboxConst("myTitle", myTitle)
  Call MyCsvLboxConst("myCmmdBarNumber", myTitle & "2")
  Call MyCsvLboxBttnType
End Sub ' MyCsvLbox2BttnType *----*----*    *----*----*    *----*----*    *----*----*

Sub MyCsvLbox2DdwnOne(Optional myDummy As Boolean)
  Dim myTitle As String
  Call MyCsvLboxConst("myTitle", myTitle)
  Call MyCsvLboxConst("myCmmdBarNumber", myTitle & "2")
  Call MyCsvLboxDdwnOne
End Sub ' MyCsvLbox2DdwnOne *----*----*    *----*----*    *----*----*    *----*----*

Sub MyCsvLbox2DdwnTwo(Optional myDummy As Boolean)
  Dim myTitle As String
  Call MyCsvLboxConst("myTitle", myTitle)
  Call MyCsvLboxConst("myCmmdBarNumber", myTitle & "2")
  Call MyCsvLboxDdwnTwo
End Sub ' MyCsvLbox2DdwnTwo *----*----*    *----*----*    *----*----*    *----*----*

Sub MyCsvLbox2BttnNext(Optional myDummy As Boolean)
  Dim myTitle As String
  Call MyCsvLboxConst("myTitle", myTitle)
  Call MyCsvLboxConst("myCmmdBarNumber", myTitle & "2")
  Call MyCsvLboxBttnNext
End Sub ' MyCsvLbox2BttnNext *----*----*    *----*----*    *----*----*    *----*----*

Sub MyCsvLbox3BttnType(Optional myDummy As Boolean)
  Dim myTitle As String
  Call MyCsvLboxConst("myTitle", myTitle)
  Call MyCsvLboxConst("myCmmdBarNumber", myTitle & "3")
  Call MyCsvLboxBttnType
End Sub ' MyCsvLbox3BttnType *----*----*    *----*----*    *----*----*    *----*----*

Sub MyCsvLbox3DdwnOne(Optional myDummy As Boolean)
  Dim myTitle As String
  Call MyCsvLboxConst("myTitle", myTitle)
  Call MyCsvLboxConst("myCmmdBarNumber", myTitle & "3")
  Call MyCsvLboxDdwnOne
End Sub ' MyCsvLbox3DdwnOne *----*----*    *----*----*    *----*----*    *----*----*

Sub MyCsvLbox3DdwnTwo(Optional myDummy As Boolean)
  Dim myTitle As String
  Call MyCsvLboxConst("myTitle", myTitle)
  Call MyCsvLboxConst("myCmmdBarNumber", myTitle & "3")
  Call MyCsvLboxDdwnTwo
End Sub ' MyCsvLbox3DdwnTwo *----*----*    *----*----*    *----*----*    *----*----*

Sub MyCsvLbox3BttnNext(Optional myDummy As Boolean)
  Dim myTitle As String
  Call MyCsvLboxConst("myTitle", myTitle)
  Call MyCsvLboxConst("myCmmdBarNumber", myTitle & "3")
  Call MyCsvLboxBttnNext
End Sub ' MyCsvLbox3BttnNext *----*----*    *----*----*    *----*----*    *----*----*

Sub MyCsvLboxBttnType(Optional myDummy As Boolean)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem 挿入ボタン処理
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Dim myTitle As String
  '
  Call MyCsvLboxConst("myCmmdBar", myTitle)
  '
  If Len(CommandBars(myTitle).Controls(2).Text) = 0 Then
    Rem [分類]を選択していない状態（通常ではあり得ない）
    Exit Sub
  End If
  '
  CommandBars(myTitle).Controls("Type").FaceId = 964
  '
  If Len(CommandBars(myTitle).Controls(3).Text) <> 0 Then
    Call MyCsvLboxText(CommandBars(myTitle).Controls(3).Text)
  Else
    Rem [本文]の項目を選択していない状態
    Call MyCsvLboxText(CommandBars(myTitle).Controls(2).Text)
  End If
  '
  CommandBars(myTitle).Controls("Type").FaceId = 31
End Sub ' MyCsvLboxBttnType *----*----*    *----*----*    *----*----*    *----*----*

Sub MyCsvLboxDdwnOne(Optional myDummy As Boolean)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem リストボックス１処理
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Dim myTitle As String
  Dim i As Long
  '
  Dim myConn As Object ' ADODB.Connection
  Dim myRecSet As Object ' ADODB.Recordset
  Dim DBPath As String
  Dim CsvDB As String
  Dim mySQL As String
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Call MyCsvLboxConst("myCmmdBar", myTitle)
  Call MyCsvLboxConst("DBPath", DBPath)
  Call MyCsvLboxConst("CsvDB", CsvDB)
  '
  Rem リストボックス２を設定し直す。
  With CommandBars(myTitle)
    .Controls("Type").FaceId = 964
    .Controls(3).Delete
    .Controls.Add Type:=msoControlDropdown, Before:=3, Temporary:=True
  End With
  '
  With CommandBars(myTitle).Controls(3)
    .DescriptionText = "リストボックス２"
    .Style = msoComboNormal
    .Caption = ""
    .TooltipText = "選択した文字列を挿入します。"
    .BeginGroup = True
    .DropDownWidth = 400
    .OnAction = myTitle & "DdwnTwo"
  End With
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  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 *----*----*    *----*----*    *----*----*    *----*----*
  '
  mySQL = "SELECT  本文 FROM  " & CsvDB & "  "
  mySQL = mySQL & "WHERE  分類='" & CommandBars(myTitle).Controls(2).Text & "';"
  '
  Rem テーブルへの参照を取得
  With myRecSet
    .ActiveConnection = myConn
    .Source = mySQL
    .Open
  End With
  '
  i = 0
  Rem レコードを転記
  Do While Not myRecSet.EOF
    i = i + 1
    '
    With CommandBars(myTitle).Controls(3)
      .AddItem myRecSet.Fields(0).Value, i
      .DropDownLines = i
      .ListIndex = 0
      .Parameter = ""
    End With
    myRecSet.MoveNext
  Loop
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Rem 接続を閉じる
  On Error Resume Next
  myRecSet.Close
  myConn.Close
  On Error GoTo 0
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  With CommandBars(myTitle)
    .Controls("Type").Enabled = True
    .Controls("Type").TooltipText = .Controls(2).Text
    If .Controls(3).ListCount > 0 Then
      .Controls("Next").Enabled = True
      .Controls("Next").TooltipText = .Controls(3).List(1)
    Else
      Rem [分類]に該当する[本文]の項目がなかった場合（通常ではあり得ない）
      .Controls("Type").TooltipText = .Controls(2).Text
      .Controls("Next").Enabled = False
      .Controls("Next").TooltipText = ""
    End If
    .Controls("Type").FaceId = 31
  End With
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Set myConn = Nothing
  Set myRecSet = Nothing
End Sub ' MyCsvLboxDdwnOne *----*----*    *----*----*    *----*----*    *----*----*

Sub MyCsvLboxDdwnTwo(Optional myDummy As Boolean)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem リストボックス２処理
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Dim myTitle As String
  '
  Call MyCsvLboxConst("myCmmdBar", myTitle)
  '
  If CommandBars(myTitle).Controls(3).Index = 0 Then
    Rem [本文]の項目を選択していない状態
    Exit Sub
  End If
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  CommandBars(myTitle).Controls("Type").FaceId = 964
  '
  Call MyCsvLboxText(CommandBars(myTitle).Controls(3).Text)
  '
  With CommandBars(myTitle)
    .Controls("Type").TooltipText = .Controls(3).Text
    If .Controls(3).ListIndex < .Controls(3).ListCount Then
      .Controls("Next").TooltipText = .Controls(3).List(.Controls(3).ListIndex + 1)
    Else
      Rem [本文]の最後の項目を選択した場合
      .Controls("Next").TooltipText = "[先頭に戻る]"
    End If
  End With
  '
  CommandBars(myTitle).Controls("Type").FaceId = 31
End Sub ' MyCsvLboxDdwnTwo *----*----*    *----*----*    *----*----*    *----*----*

Sub MyCsvLboxBttnNext(Optional myDummy As Boolean)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem 次へボタン処理
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Dim myTitle As String
  '
  Call MyCsvLboxConst("myCmmdBar", myTitle)
  '
  With CommandBars(myTitle)
    Select Case True
      Case Len(.Controls(2).Text) = 0
        Rem [分類]を選択していない状態（通常ではあり得ない）
        Exit Sub
      Case .Controls(3).ListIndex >= .Controls(3).ListCount
        Rem 既に[本文]の最後の項目を選択している状態
        .Controls(3).ListIndex = 0
        .Controls("Type").TooltipText = .Controls(2).Text
        .Controls("Next").TooltipText = .Controls(3).List(1)
        Rem ポップヒントを無理やり表示させる。（苦肉の策！）
        Call MyCsvLboxFullScreen
        Beep
        Exit Sub
    End Select
  End With
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  With CommandBars(myTitle)
    .Controls("Next").FaceId = 964
    .Controls(3).ListIndex = .Controls(3).ListIndex + 1
    .Controls("Type").TooltipText = .Controls(3).Text
  End With
  '
  Call MyCsvLboxText(CommandBars(myTitle).Controls(3).Text)
  '
  With CommandBars(myTitle)
    If .Controls(3).ListIndex >= .Controls(3).ListCount Then
      Rem [本文]の最後の項目を選択した状態
      .Controls("Next").TooltipText = "[先頭に戻る]"
    Else
      Rem 次の[本文]項目のポップヒント表示を設定する。
      .Controls("Next").TooltipText = .Controls(3).List(.Controls(3).ListIndex + 1)
    End If
    .Controls("Next").FaceId = 157
  End With
  '
  Rem ポップヒントを無理やり表示させる。（苦肉の策！）
  Call MyCsvLboxFullScreen
End Sub ' MyCsvLboxBttnNext *----*----*    *----*----*    *----*----*    *----*----*

Sub MyCsvLboxText(mytext As String)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem 文字列挿入処理
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Dim myTitle As String
  '
  Call MyCsvLboxConst("myCmmdBar", myTitle)
  '
  Rem 括弧・引用符の中にカーソルを移す。
  If mytext <> CommandBars(myTitle).Controls(2).Text Then
    Select Case CommandBars(myTitle).Controls(2).Text
      Case "半角括弧", "全角括弧", "引用符"
        Call MyCsvLboxTextBracket(myTitle, mytext)
        Exit Sub
    End Select
  End If
  '
  Selection.TypeText mytext
End Sub ' MyCsvLboxText *----*----*    *----*----*    *----*----*    *----*----*

Sub MyCsvLboxTextBracket(myTitle As String, mytext As String)
  If Len(Selection.Range.Text) > 0 Then
    Select Case True
      Case mytext = "〔←〕"
        mytext = Left(mytext, 2) & Selection.Range.Text & Right(mytext, 1)
      Case CommandBars(myTitle).Controls(2).Text = "全角括弧"
        mytext = Left(mytext, 1) & Selection.Range.Text & Right(mytext, 1)
      Case CommandBars(myTitle).Controls(2).Text = "引用符"
        mytext = Left(mytext, 1) & Selection.Range.Text & Right(mytext, 1)
      Case CommandBars(myTitle).Controls(2).Text = "半角括弧"
        mytext = Left(mytext, 2) & Selection.Range.Text & Right(mytext, 2)
    End Select
    Selection.TypeText mytext
    Exit Sub
  End If
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Selection.TypeText mytext
  '
  Rem 括弧・引用符の中にカーソルを移す。
  If mytext <> CommandBars(myTitle).Controls(2).Text Then
    Select Case CommandBars(myTitle).Controls(2).Text
      Case "全角括弧", "引用符"
        Selection.MoveLeft Unit:=wdCharacter, Count:=1
      Case "半角括弧"
        Selection.MoveLeft Unit:=wdCharacter, Count:=2
    End Select
  End If
End Sub ' MyCsvLboxTextBracket *----*----*    *----*----*    *----*----*    *----*----*

Sub MyCsvLboxFullScreen(Optional myDummy As Boolean)
  Dim myHeight As Long
  Dim myWidth As Long
  Dim myTop As Long
  Dim myLeft As Long
  '
  Application.ScreenUpdating = False
  '
  If ActiveWindow.WindowState = wdWindowStateMaximize Then
    myTop = Application.Top
    myLeft = Application.Left
    myWidth = Application.Width
    myHeight = Application.Height
    '
    ActiveWindow.WindowState = wdWindowStateNormal
    '
    Application.Top = myTop
    Application.Left = myLeft
    Application.Width = myWidth - 1
    Application.Height = myHeight - 1
  Else
    Rem wdWindowStateNormalの場合
    ActiveWindow.View.FullScreen = Not ActiveWindow.View.FullScreen ' フルスクリーン表示。
    ActiveWindow.View.FullScreen = Not ActiveWindow.View.FullScreen ' フルスクリーン表示を解除。
  End If
  '
  Application.ScreenUpdating = True
End Sub ' MyCsvLboxFullScreen *----*----*    *----*----*    *----*----*    *----*----*

Sub MyCsvLboxConst(myFlag As String, myString As String)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem 既定値設定処理
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Static myTitleStatic As String
  Static myCmmdBarStatic As String
  Dim myShell As Object
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Select Case myFlag
    Case "myTitleNew"
      myTitleStatic = myString
    Case "myTitle"
      myString = myTitleStatic
    Case "myCmmdBarNumber"
      myCmmdBarStatic = myString
    Case "myCmmdBar"
      myString = myCmmdBarStatic
    Case "DBPath"
      Set myShell = CreateObject("WScript.Shell")
      myString = myShell.SpecialFolders("MyDocuments")
      myString = myString & "\" & myTitleStatic
    Case "CsvDB"
      myString = "MyCsvLbox.csv"
  End Select
  '
  Set myShell = Nothing
End Sub ' MyCsvLboxConst *----*----*    *----*----*    *----*----*    *----*----*

Sub MyCsvLboxSchemaIni() ' (Optional myDummy As Boolean)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem MyCsvLbox初期設定処理
  Rem （「MyCsvLbox」初回実行前に一度だけ実行）
  Rem 機能...
  Rem   1. MyCsvLboxの初期設定をする。
  Rem      見出し情報や内部構造をODBCに伝えるために、
  Rem      CSVファイルの保存先フォルダに「schema.ini」ファイルを作成する。
  Rem   2.「DBPath」にCSVファイルの保存先フォルダを指定すること。（MyCsvLboxConstで指定。）
  Rem      関連フォルダ名の既定値は、マイドキュメントの\MyCsvLboxフォルダ。
  Rem   3. この処理で、関連フォルダと「schema.ini」ファイルを作成する。
  Rem   4. この処理で、関連CSVファイルを作成する。
  Rem      （関連CSVファイル名の既定値は、MyCsvLbox.csv。MyCsvLboxConstで指定。）
  Rem      作成するCSVファイルの1行目は見出し行とする。
  Rem      この処理で作成する2行目以降のデータは一例。
  Rem 注記...
  Rem   1. 佐藤信正『VBScript実用プログラミング・テクニック』メディア・テック出版の
  Rem      「Part5 [16]12万件の郵便番号を検索する」から引用した。
  Rem   2．「MyCsvLbox」初回実行前に先行して一度だけ実行すること。
  Rem   3．この処理後に、関連CSVファイルを編集して、MyCsvLboxのデータを作成すること。
  Rem 履歴...
  Rem   第01版：2008/08/30 作成。
  Rem   第02版：2012/05/28 関連フォルダ・関連CSVファイルの作成を追加。
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Dim myFso As Object
  Dim myFile As Object
  '
  Dim DBPath As String
  Dim CsvDB As String
  Dim IniFile As String
  Dim myFullName As String
  '
  Dim myTitle As String
  Dim myStatusBar As String
  Dim myMsg As String
  Dim myAns As Long
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  myTitle = "MyCsvLbox"
  Call MyCsvLboxConst("myTitleNew", myTitle)
  Call MyCsvLboxConst("DBPath", DBPath)
  Call MyCsvLboxConst("CsvDB", CsvDB)
  '
  myTitle = "MyCsvLboxSchemaIni"
  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 関連フォルダを作成する。
  myFso.CreateFolder DBPath
  Rem 関連ファイルを作成する。
  Set myFile = myFso.CreateTextFile(myFullName)
  With myFile
    .WriteLine ("[" & CsvDB & "]") ' ("[MyCsvLbox.csv]")
    '
    .WriteLine ("ColNameHeader=True") ' 見出し行の有無：ありを指定。
    .WriteLine ("CharacterSet=oem")
    .WriteLine ("Format=CSVDelimited")
    '
    .WriteLine ("Col1=分類 Char Width 255")
    .WriteLine ("Col2=本文 Char Width 255")
    .Close
  End With
  '
  Rem 関連CSVファイルを作成する。
  Rem 1行目は見出し行。2行目以降は一例。
  Set myFile = myFso.CreateTextFile(DBPath & "\" & CsvDB)
  With myFile
    .WriteLine "分類,本文"
    .WriteLine "全角括弧,（）"
    .WriteLine "全角括弧,〈〉"
    .WriteLine "全角括弧,《》"
    .WriteLine "全角括弧,〔〕"
    .WriteLine "全角括弧,〔〕"
    .WriteLine "記号,…"
    .WriteLine "記号,(1)"
    .WriteLine "記号,(2)"
    .WriteLine "記号,(3)"
    .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 ' MyCsvLboxSchemaIni *----*----*    *----*----*    *----*----*    *----*----*