Sub EspDialogReplace()
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem エスペラント語[検索と置換]ダイアログボックス表示処理
  Rem 作譜:Hitrock Camellia Shinopy
  Rem 言語:Word VBA
  Rem 機能...
  Rem   1. 入力した代用表記の文字列を正書文字に変更する。
  Rem   2. 入力した文字列を[検索と置換]ダイアログボックス上に表示する。
  Rem 注記...
  Rem   1.「EspDialogReplace」を起動して、処理を実行する。
  Rem   2.「検索と置換」の画面立ち上げ支援マクロ処理を参照して作成。
  Rem      http://wordvba.cocolog-nifty.com/blog/2010/04/post-8963.html
  Rem 履歴...
  Rem   第01版:2010/10/05:作成。
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Dim myTitle As String
  '
  myTitle = "EspDialogReplace"
  '
  On Error Resume Next
  CommandBars(myTitle).Delete
  On Error GoTo 0
  '
EspDialogReplaceSubEntry:
  Call EspDialogReplacePopUp(myTitle)
  If CommandBars(myTitle).Controls(1).FaceId = 330 Then GoTo EspDialogReplaceSubExit
  '
  With Selection.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = CommandBars(myTitle).Controls("検索").Text
    .Replacement.Text = CommandBars(myTitle).Controls("置換").Text
    Select Case CommandBars(myTitle).Controls(4).Caption
      Case "大文字と小文字を区別しない。": .MatchCase = False
      Case "大文字と小文字を区別する。": .MatchCase = True
    End Select
  End With
  '
  On Error Resume Next
  Dialogs(wdDialogEditReplace).Show
  On Error GoTo 0
  '
EspDialogReplaceSubExit:
  On Error Resume Next
  CommandBars(myTitle).Delete
  On Error GoTo 0
End Sub ' EspDialogReplace *----*----*    *----*----*    *----*----*    *----*----*

Sub EspDialogReplacePopUp(myTitle As String)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem ポップアップメニュー表示処理
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Dim myCmmdBar As CommandBar
  Dim myCtrlBttnIcon As CommandBarControl
  Dim myCtrlEditFind As CommandBarControl
  Dim myCtrlEditReplace As CommandBarControl
  Dim myCtrlMatchCase As CommandBarControl
  Dim myCtrlBttnCancel As CommandBarControl
  Dim myCtrlBttnOk As CommandBarControl
  '
  Dim i As Long
  Dim x As Long
  Dim y As Long
  Dim myFaceId As Long
  Static myMatchCase As Boolean
  Dim myMsg As String
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Set myCmmdBar = CommandBars.Add(Name:=myTitle, Position:=msoBarPopup, Temporary:=True)
  Set myCtrlBttnIcon = myCmmdBar.Controls.Add(Type:=msoControlButton, Before:=1, Temporary:=True)
  Set myCtrlEditFind = myCmmdBar.Controls.Add(Type:=msoControlEdit, Before:=2, Temporary:=True)
  Set myCtrlEditReplace = myCmmdBar.Controls.Add(Type:=msoControlEdit, Before:=3, Temporary:=True)
  Set myCtrlMatchCase = myCmmdBar.Controls.Add(Type:=msoControlButton, Before:=4, Temporary:=True)
  Set myCtrlBttnCancel = myCmmdBar.Controls.Add(Type:=msoControlButton, Before:=5, Temporary:=True)
  Set myCtrlBttnOk = myCmmdBar.Controls.Add(Type:=msoControlButton, Before:=6, Temporary:=True)
  '
  myMsg = myTitle & vbCrLf
  myMsg = myMsg & "エスペラント語[検索と置換]ダイアログボックス表示処理" & vbCrLf & vbCrLf
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  With myCtrlBttnIcon
    .DescriptionText = "[検索と置換]ダイアログボックス表示処理ポップアップメニュー"
    .Style = msoButtonIconAndWrapCaption
    .Caption = myMsg & "入力して下さい。"
    .TooltipText = "入力して下さい。"
    .FaceId = 1089
    myFaceId = .FaceId
    .OnAction = myTitle & "BttnIcon"
  End With
  '
  With myCtrlEditFind
    .DescriptionText = "[検索]エディットボックス"
    .Caption = "検索"
    .TooltipText = "検索したい文字列を入力して下さい。"
    .BeginGroup = True
    .OnAction = myTitle & "EditFind"
  End With
  '
  With myCtrlEditReplace
    .DescriptionText = "[置換]エディットボックス"
    .Caption = "置換"
    .TooltipText = "置き換え文字列を入力して下さい。"
    .BeginGroup = True
    .OnAction = myTitle & "EditReplace"
  End With
  '
  With myCtrlMatchCase
    .DescriptionText = "[大文字と小文字を区別する]ボタン"
    .Style = msoButtonIconAndWrapCaption
    Select Case myMatchCase
       Case True
         .FaceId = 220
         .Caption = "大文字と小文字を区別する。"
         .TooltipText = "大文字と小文字を区別して検索します。"
       Case False
         .FaceId = 6963
         .Caption = "大文字と小文字を区別しない。"
         .TooltipText = "大文字と小文字を区別せずに検索します。"
    End Select
    .Parameter = ""
    .OnAction = myTitle & "MatchCase"
  End With
  '
  With myCtrlBttnCancel
    .DescriptionText = "[キャンセル]ボタン"
    .BeginGroup = True
    .Style = msoButtonIconAndCaption
    .Caption = "キャンセル"
    .TooltipText = "処理を中止します。"
    .FaceId = 330
    .OnAction = myTitle & "BttnCancel"
  End With
  '
  With myCtrlBttnOk
    .DescriptionText = "[OK]ボタン"
    .BeginGroup = True
    .Style = msoButtonIconAndWrapCaption
    .Caption = "OK"
    .TooltipText = "[検索と置換]ダイアログボックスを表示します。"
    .FaceId = 157
    .Parameter = ""
    .OnAction = myTitle & "BttnOk"
  End With
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  x = -1: y = -1
  myFaceId = myCmmdBar.Controls(1).FaceId
  Beep
  '
  Do
    On Error Resume Next
    If x = -1 Then
      myCmmdBar.ShowPopup
    Else
      myCmmdBar.ShowPopup x, y
    End If
    On Error GoTo 0
    DoEvents
    '
    Select Case myCmmdBar.Controls(1).FaceId
      Case 157, 330 ' [OK]・[キャンセル]
        Exit Do
      Case 1850 ' [検索]・[置換]
        x = myCmmdBar.Left
        y = myCmmdBar.Top
      Case 220, 6963 ' [チェックボックス]オン・オフ
        x = myCmmdBar.Left
        y = myCmmdBar.Top
      Case 1089
        x = -1: y = -1
      Case Else
        x = -1: y = -1
    End Select
    myCmmdBar.Controls(1).FaceId = myFaceId
    Select Case myCmmdBar.Controls(4).Caption
      Case "大文字と小文字を区別しない。": myMatchCase = False
      Case "大文字と小文字を区別する。": myMatchCase = True
    End Select
  Loop
End Sub ' EspDialogReplacePopUp *----*----*    *----*----*    *----*----*    *----*----*

Sub EspDialogReplaceBttnIcon(Optional MyDummy As Boolean)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem [メニュー]処理
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  CommandBars("EspDialogReplace").Controls(1).FaceId = 1089
End Sub ' EspDialogReplaceBttnIcon *----*----*    *----*----*    *----*----*    *----*----*

Sub EspDialogReplaceEditFind(Optional MyDummy As Boolean)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem [検索]入力処理
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Dim myText As String
  '
  myText = CommandBars("EspDialogReplace").Controls("検索").Text
  Call EspDialogReplaceText(myText)
  CommandBars("EspDialogReplace").Controls("検索").Text = myText
  CommandBars("EspDialogReplace").Controls(1).FaceId = 1850
End Sub ' EspDialogReplaceEditFind *----*----*    *----*----*    *----*----*    *----*----*

Sub EspDialogReplaceEditReplace(Optional MyDummy As Boolean)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem [置換]入力処理
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Dim myText As String
  '
  myText = CommandBars("EspDialogReplace").Controls("置換").Text
  Call EspDialogReplaceText(myText)
  CommandBars("EspDialogReplace").Controls("置換").Text = myText
  CommandBars("EspDialogReplace").Controls(1).FaceId = 1850
End Sub ' EspDialogReplaceEditReplace *----*----*    *----*----*    *----*----*    *----*----*

Sub EspDialogReplaceMatchCase(Optional MyDummy As Boolean)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem [大文字と小文字を区別する]ボタン処理
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  With CommandBars("EspDialogReplace").Controls(4)
    Select Case .FaceId
       Case 6963
         .FaceId = 220
         .Caption = "大文字と小文字を区別する。"
         .TooltipText = "大文字と小文字を区別して検索します。"
         CommandBars("EspDialogReplace").Controls(1).FaceId = 220
       Case 220
         .FaceId = 6963
         .Caption = "大文字と小文字を区別しない。"
         .TooltipText = "大文字と小文字を区別せずに検索します。"
         CommandBars("EspDialogReplace").Controls(1).FaceId = 6963
    End Select
  End With
End Sub ' EspDialogReplaceMatchCase *----*----*    *----*----*    *----*----*    *----*----*

Sub EspDialogReplaceBttnCancel(Optional MyDummy As Boolean)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem [キャンセル]ボタン処理
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  CommandBars("EspDialogReplace").Controls(1).FaceId = 330
End Sub ' EspDialogReplaceBttnCancel *----*----*    *----*----*    *----*----*    *----*----*

Sub EspDialogReplaceBttnOk(Optional MyDummy As Boolean)
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem [OK]ボタン処理
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  CommandBars("EspDialogReplace").Controls(1).FaceId = 157
End Sub ' EspDialogReplaceBttnOk *----*----*    *----*----*    *----*----*    *----*----*

Sub EspDialogReplaceText(myText As String)
  myText = Replace(myText, "cx", ChrW(265))
  myText = Replace(myText, "gx", ChrW(285))
  myText = Replace(myText, "hx", ChrW(293))
  myText = Replace(myText, "jx", ChrW(309))
  myText = Replace(myText, "sx", ChrW(349))
  myText = Replace(myText, "ux", ChrW(365))
  '
  myText = Replace(myText, "Cx", ChrW(264))
  myText = Replace(myText, "Gx", ChrW(284))
  myText = Replace(myText, "Hx", ChrW(292))
  myText = Replace(myText, "Jx", ChrW(308))
  myText = Replace(myText, "Sx", ChrW(348))
  myText = Replace(myText, "Ux", ChrW(364))
  '
  myText = Replace(myText, "c^", ChrW(265))
  myText = Replace(myText, "g^", ChrW(285))
  myText = Replace(myText, "h^", ChrW(293))
  myText = Replace(myText, "j^", ChrW(309))
  myText = Replace(myText, "s^", ChrW(349))
  myText = Replace(myText, "u^", ChrW(365))
  '
  myText = Replace(myText, "C^", ChrW(264))
  myText = Replace(myText, "G^", ChrW(284))
  myText = Replace(myText, "H^", ChrW(292))
  myText = Replace(myText, "J^", ChrW(308))
  myText = Replace(myText, "S^", ChrW(348))
  myText = Replace(myText, "U^", ChrW(364))
  '
  myText = Replace(myText, "a_", ChrW(226))
  myText = Replace(myText, "e_", ChrW(234))
  myText = Replace(myText, "i_", ChrW(238))
  myText = Replace(myText, "o_", ChrW(244))
  myText = Replace(myText, "u_", ChrW(251))
  '
  myText = Replace(myText, "A_", ChrW(194))
  myText = Replace(myText, "E_", ChrW(202))
  myText = Replace(myText, "I_", ChrW(206))
  myText = Replace(myText, "O_", ChrW(212))
  myText = Replace(myText, "U_", ChrW(219))
End Sub ' EspDialogReplaceText *----*----*    *----*----*    *----*----*    *----*----*

inserted by FC2 system