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 第02版：2018/10/28：アイコン表示を変更。
Rem *----*----* *----*----* *----*----* *----*----*
Dim myTitle As String
'
myTitle = "EspDialogReplace"
'
On Error Resume Next
CommandBars(myTitle).Delete
On Error GoTo 0
'
EspDialogReplaceSubEntry:
Do
Call EspDialogReplacePopUp(myTitle)
If CommandBars(myTitle).Controls(1).FaceId = 330 Then Exit Do
'
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
'
Exit Do
Loop
'
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 x As Long
Dim y As Long
Dim myFaceId As Long
Dim myMsg As String
Rem *----*----* *----*----* *----*----* *----*----*
'
Call EspDialogReplaceCmmdBar(myTitle)
Set myCmmdBar = CommandBars(myTitle)
'
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 2201 ' [大文字と小文字を区別する]
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
Loop
End Sub ' EspDialogReplacePopUp *----*----* *----*----* *----*----* *----*----*
Sub EspDialogReplaceCmmdBar(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 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
myMsg = myMsg & "ダイアログボックス表示処理" & String(20, " ") & vbCrLf
Rem *----*----* *----*----* *----*----* *----*----*
'
With myCtrlBttnIcon
.DescriptionText = "[検索と置換]ダイアログボックス表示処理ショートカットメニュー"
.Style = msoButtonIconAndWrapCaption
.Caption = myMsg & "入力して下さい。"
.TooltipText = "入力して下さい。"
.FaceId = 1089
.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 Selection.Find.MatchCase
Case True
.Caption = "大文字と小文字を区別する。"
.TooltipText = "大文字と小文字を区別して検索します。"
Case False
.Caption = "大文字と小文字を区別しない。"
.TooltipText = "大文字と小文字を区別せずに検索します。"
End Select
.BeginGroup = True
.FaceId = 2201
.OnAction = myTitle & "MatchCase"
End With
'
With myCtrlBttnCancel
.DescriptionText = "[キャンセル]ボタン"
.BeginGroup = True
.Style = msoButtonIconAndCaption
.Caption = "キャンセル"
.TooltipText = "処理を中止します。"
.BeginGroup = True
.FaceId = 330
.OnAction = myTitle & "BttnCancel"
End With
'
With myCtrlBttnOk
.DescriptionText = "[OK]ボタン"
.BeginGroup = True
.Style = msoButtonIconAndWrapCaption
.Caption = "OK"
.TooltipText = "[検索と置換]ダイアログボックスを表示します。"
.BeginGroup = True
.FaceId = 157
.OnAction = myTitle & "BttnOk"
End With
End Sub ' EspDialogReplaceCmmdBar *----*----* *----*----* *----*----* *----*----*
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 .Caption
Case "大文字と小文字を区別しない。"
.Caption = "大文字と小文字を区別する。"
.TooltipText = "大文字と小文字を区別して検索します。"
Case "大文字と小文字を区別する。"
.Caption = "大文字と小文字を区別しない。"
.TooltipText = "大文字と小文字を区別せずに検索します。"
End Select
End With
'
CommandBars("EspDialogReplace").Controls(1).FaceId = 2201
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 *----*----* *----*----* *----*----* *----*----*
