Sub myTypeText()
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem 指定文字列挿入処理（CSVファイル読み込み）
  Rem 記録者：Hitrock Camellia Shinopy
  Rem 言語：Word VBA
  Rem 機能：CSVファイルを読み込み、指定された文字列を文書上に挿入する。
  Rem 注記...
  Rem   myTypeTextを起動して使用｡
  Rem   CSVファイルの保存先フォルダ・ファイルを指定すること｡
  Rem   この処理は、100件分処理可能な状態。
  Rem   起動直後は、1頁目をバルーンに表示する。
  Rem   CSVファイルの1行目を見出し行とする。
  Rem   CSVファイルの1列目をボタン項目名とする。
  Rem   CSVファイルの6列目までの内容を読み込む。
  Rem 履歴...
  Rem   第1版：2003/07/03：作成。
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Dim blln As Balloon
  Dim bttn As Long
  Dim bllnID As Long
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Rem 初期処理を実行させる。
  bttn = -888
  Call myTypeTextBttn(blln, bttn, bllnID)
End Sub ' myTypeText *----*----*    *----*----*    *----*----*    *----*----*

Sub myTypeTextBlln(myPage As Integer, myMax As Variant, myCbox As Variant, myArray As Variant)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem バルーン表示処理
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Dim i As Integer
  Dim myTitle As String
  Dim myText As String
  Dim myLabelMin As Integer
  Dim myBacklog As Integer
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  myTitle = "myTypeText"
  Assistant.Visible = True
  Application.StatusBar = myTitle & "：選択して下さい。"
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  With Assistant.NewBalloon
    .Animation = msoAnimationIdle
    .BalloonType = msoBalloonTypeButtons
    .Icon = msoIconAlertQuery
    Rem *----*----*    *----*----*
    myText = myTitle & vbCr & "指定文字列" & " " & "挿入処理" & vbCr
    myText = myText & myPage & "/" & myMax(2) & "頁" & vbCr
    .Heading = myText
    .Text = "選択して下さい。"
    Rem *----*----*    *----*----*
    If myPage = 1 Then
      Rem 最初頁
      .Labels(1).Text = "[改行]"
      .Labels(2).Text = "[Backspace]"
      .Labels(3).Text = "[切替]" & " " & "文字列挿入時：" & vbCr & "区切り文字を指定 "
      Rem *----*----*    *----*----*
      For i = 1 To 5
        .Checkboxes(i).Checked = myCbox(i + 5)
      Next i
      Select Case myCbox(0)
        Case 1
          .Checkboxes(1).Text = "区切り文字：タブ"
        Case 2
          .Checkboxes(1).Text = "区切り文字：全角空白"
        Case 3
          .Checkboxes(1).Text = "区切り文字：半角空白"
        Case 4
          .Checkboxes(1).Text = "区切り文字：「・」"
        Case 5
          .Checkboxes(1).Text = "区切り文字：改行"
        Case 6
          .Checkboxes(1).Text = "区切り文字：（なし）"
      End Select
      .Checkboxes(2).Text = "項目の最後に改行する。"
      .Checkboxes(3).Text = " "
      .Checkboxes(4).Text = " "
      .Checkboxes(5).Text = "ボタン項目：空白文字を削る。"
      .Button = msoButtonSetNextClose
    Else
      Rem 次頁以降
      myLabelMin = 5 * (myPage - 2) + 1
      myMax(3) = myLabelMin
      myBacklog = myMax(0) - myLabelMin + 1
      If myPage < myMax(2) Then
        Rem 中間頁
        For i = 1 To 5
          .Labels(i).Text = myArray(myLabelMin + i - 1, 0)
          myBacklog = myBacklog - 1
          If myBacklog = 0 Then
            Exit For
          End If
        Next i
        .Button = msoButtonSetBackNextClose
      Else
        Rem 最終頁
        .Labels(1).Text = "（全部）"
        .Button = msoButtonSetBackClose
      End If
      Rem *----*----*    *----*----*
      For i = 1 To myMax(1)
        .Checkboxes(i).Checked = myCbox(i)
        .Checkboxes(i).Text = myArray(0, i)
      Next i
    End If
    Rem *----*----*    *----*----*
    .Mode = msoModeModeless
    .Callback = "myTypeTextBttn"
    .Show
  End With
End Sub ' myTypeTextBlln *----*----*    *----*----*    *----*----*    *----*----*

Sub myTypeTextBttn(blln As Balloon, bttn As Long, bllnID As Long)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem 各ボタン処理
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Static myPage As Integer
  Static myMax As Variant
  Static myCbox As Variant
  Static myArray As Variant
  '
  Dim c As Integer
  Dim i As Integer
  Dim myTitle As String
  Dim myText As String
  Dim mySuffix As String
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  myTitle = "myTypeText"
  '
  Select Case bttn
    Case msoBalloonButtonCancel, msoBalloonButtonClose
      If myPage = 1 Then
        For i = 6 To 10
          myCbox(i) = blln.Checkboxes.Item(i - 5).Checked
        Next i
      Else
        For i = 1 To myMax(1)
          myCbox(i) = blln.Checkboxes.Item(i).Checked
        Next i
      End If
      blln.Close
      Assistant.Visible = False
      Exit Sub
    Case -888 ' 初期処理
      Call myTypeTextInit(myPage, myMax, myCbox, myArray)
      If myMax(0) <= 0 Then
        myText = "CSVファイルに、データがありません。"
        MsgBox myText, vbOKOnly & vbCritical, myTitle
        Exit Sub
      End If
      Call myTypeTextBlln(myPage, myMax, myCbox, myArray)
      Exit Sub
  End Select
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
myTypeTextBttnSubEntry:
  Select Case bttn
    Case 1 To 5
      If myPage = 1 Then
        For i = 6 To 10
          myCbox(i) = blln.Checkboxes.Item(i - 5).Checked
        Next i
        Select Case bttn
          Case 1
            Selection.TypeParagraph
          Case 2
            Selection.TypeBackspace
          Case 3
            Select Case myCbox(0)
              Case 6
                myCbox(0) = 1
              Case Else
                myCbox(0) = myCbox(0) + 1
            End Select
        End Select
        myText = blln.Labels.Item(bttn).Text
        myText = Replace(myText, vbCr, "")
      Else
        myMax(4) = 0
        For i = 1 To myMax(1)
          myCbox(i) = blln.Checkboxes.Item(i).Checked
          If myCbox(i) = True Then
            myMax(4) = i
          End If
        Next i
        '
        If myCbox(6) = True Then
          Select Case myCbox(0)
            Case 1
              mySuffix = vbTab
            Case 2
              mySuffix = "　"
            Case 3
              mySuffix = " "
            Case 4
              mySuffix = "・"
            Case 5
              mySuffix = vbCrLf
            Case Else
              mySuffix = ""
          End Select
        End If
        '
        c = myMax(3) + bttn - 1
        If c <= myMax(0) Then
          Call myTypeTextType(c, mySuffix, myPage, myMax, myCbox, myArray)
        Else
          i = c - 5 * (myMax(2) - 2)
          Select Case i
            Case 1
              For c = 1 To myMax(0)
                Call myTypeTextType(c, mySuffix, myPage, myMax, myCbox, myArray)
              Next c
          End Select
        End If
        myText = blln.Labels.Item(bttn).Text
      End If
      beep
      Call myTypeTextBlln(myPage, myMax, myCbox, myArray)
      Rem *----*----*    *----*----*
      '
    Case msoBalloonButtonBack
      If myPage = 1 Then
        Rem For i = 6 To 10
        Rem   myCbox(i) = blln.Checkboxes.Item(i - 5).Checked
        Rem Next i
      Else
        For i = 1 To myMax(1)
          myCbox(i) = blln.Checkboxes.Item(i).Checked
        Next i
      End If
      myPage = myPage - 1
      Call myTypeTextBlln(myPage, myMax, myCbox, myArray)
      Rem *----*----*    *----*----*
      '
    Case msoBalloonButtonNext
      If myPage = 1 Then
        For i = 6 To 10
          myCbox(i) = blln.Checkboxes.Item(i - 5).Checked
        Next i
      Else
        For i = 1 To myMax(1)
          myCbox(i) = blln.Checkboxes.Item(i).Checked
        Next i
      End If
      myPage = myPage + 1
      Call myTypeTextBlln(myPage, myMax, myCbox, myArray)
  End Select
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
myTypeTextBttnSubExit:
  If Tasks.Exists(Name:="Microsoft Word") = True Then
    Tasks("Microsoft Word").Activate
  End If
  '
  With Assistant
    Rem 次のボタン押下に備える。
    .Visible = True
    .Animation = msoAnimationCharacterSuccessMajor
  End With
  '
  Select Case bttn
    Case 1 To 5
      Application.StatusBar = myTitle & "：" & "[ " & myText & " ]" & "を選択しました。"
    Case msoBalloonButtonBack
      Application.StatusBar = myTitle & "：" & myPage & "/" & myMax(2) & "頁へ戻りました。"
    Case msoBalloonButtonNext
      Application.StatusBar = myTitle & "：" & myPage & "/" & myMax(2) & "頁へ進みました。"
  End Select
End Sub ' myTypeTextBttn *----*----*    *----*----*    *----*----*    *----*----*

Sub myTypeTextType(c As Integer, mySuffix As String, myPage As Integer, myMax As Variant, myCbox As Variant, myArray As Variant)
  Dim i As Integer
  Dim myText As String
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  myText = myArray(c, 0)
  If myCbox(10) = True Then
    myText = Replace(myText, " ", "")
    myText = Replace(myText, "　", "")
  End If
  '
  Selection.TypeText (myText & mySuffix)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  For i = 1 To myMax(1)
    If myCbox(i) = True Then
      myText = myArray(c, i)
      If i <> myMax(4) Then
        Selection.TypeText (myText & mySuffix)
      Else
        Selection.TypeText (myText)
      End If
    End If
  Next i
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  If myCbox(7) = True Then
    Selection.TypeParagraph
  End If
End Sub ' myTypeTextType *----*----*    *----*----*    *----*----*    *----*----*

Sub myTypeTextInit(myPage As Integer, myMax As Variant, myCbox As Variant, myArray As Variant)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem 初期処理
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  If TypeName(myArray) <> "Empty" Then Exit Sub
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Dim myShell As Variant ' IWshShell3
  Dim myFso As Variant
  Dim myFile As Variant
  '
  Dim myFolder As String
  Dim myFullName As String
  Dim myText As String
  Dim myLine As Variant
  '
  Dim i As Long
  Dim c As Long
  Dim myTitle As String
  Dim myStatusBar As String
  Dim myMsg As String
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  myTitle = "myTypeText"
  Rem 0:データ総数 1:次頁以降チェックボックス数 2:ページ総数 3:myLabelMin値
  Rem 4:次頁以降チェックボックス最終オン項目。
  ReDim myMax(4)
  Rem 0:項目挿入時の区切り文字 1-5:次頁以降チェックボックス値 6-10:最初頁チェックボックス値。
  ReDim myCbox(10)
  '
  For i = 0 To UBound(myCbox)
    myCbox(i) = False
  Next i
  myCbox(0) = 1 ' [区切り文字：タブ]
  myCbox(6) = True ' [区切り文字：]
  myCbox(7) = True ' [項目の最後に改行する。]
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Set myShell = CreateObject("WScript.Shell")
  Set myFso = CreateObject("Scripting.FileSystemObject")
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Rem CSVファイルの保存先フォルダ・ファイル（指定要）｡
  myFolder = myShell.Specialfolders("MyDocuments") ' マイドキュメント
  myFolder = myFolder & "\Zzz"
  myFile = "\myTypeText.csv"
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  myFullName = myFolder & "\" & myFile
  Set myFile = myFso.OpenTextFile(myFullName, 1)
  '
  myText = myFile.ReadLine
  myLine = Split(myText, ",")
  myMax(1) = UBound(myLine)
  '
  Select Case True
    Case myMax(1) > 5
      myMax(1) = 5
    Case myMax(1) < 0
      myMax(0) = 0
      Exit Sub
  End Select
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Rem 100件分処理可能な状態。
  ReDim myArray(100, myMax(1))
  '
  c = 0
  For i = 0 To myMax(1)
    myArray(c, i) = myLine(i)
  Next i
  '
  Do Until myFile.AtEndOfStream
    myText = myFile.ReadLine
    myLine = Split(myText, ",")
    '
    If myLine(0) <> "" Then
      c = c + 1
      For i = 0 To myMax(1)
        myArray(c, i) = myLine(i)
      Next i
    End If
    '
    myStatusBar = myTitle & "：処理中" & " " & Format(c, "###0") & "件 "
    myStatusBar = myStatusBar & "( " & myFullName & "から辞書を作成中" & " )"
    Application.StatusBar = myStatusBar
  Loop
  '
  myFile.Close
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  beep
  myMax(0) = c
  myStatusBar = myTitle & "：CSVデータの読み込み完了！　"
  Application.StatusBar = myStatusBar & "総数：" & myMax(0) & "件"
  '
  myPage = 1
  myMax(2) = Int((myMax(0) - 1) / 5) + 3
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Set myShell = Nothing
  Set myFso = Nothing
  Set myFile = Nothing
  Rem Set myArray = Nothing ' 呼び出し元で使うため、解放しない。
End Sub ' myTypeTextInit *----*----*    *----*----*    *----*----*    *----*----*