Declare Function GetAsyncKeyState Lib "User32.dll" (ByVal vKey As Long) As Long Sub EspVortizo() Rem *----*----* *----*----* *----*----* *----*----* Rem エスペラント語 代用文字 範囲内 置換処理/PEJVO 辞書ファイル 照会処理 Rem (コロン区切り形式ファイル SQL文指定 データ参照処理) Rem 作譜:Hitrock Camellia Shinopy Rem 言語:Word VBA Rem 機能... Rem 1. エスペラント語代用文字を正書文字に置換する。 Rem 2. エスペラント語正書文字を代用文字に置換する。 Rem 3. 範囲選択した文字列で辞書ファイルの単語・訳語を検索する。 Rem 4. 検索した文字列に該当する単語・訳語を文書上に書き出しする。 Rem 注記... Rem 1.「EspVortizo」を起動して、ツールバーを追加し、コマンドボタンを押して、処理を実行する。 Rem 2. [エスペラント語 代用文字 範囲内 置換処理]に不具合あり。 Rem EspizoSuff実行後に、カーソル位置が選択範囲の末尾より1〜2文字分左になることがある。 Rem 3. コロン区切り形式ファイルを参照する部分を、下記の書籍から引用して、Word VBA用に改変した。 Rem 小島政行『VisualBasic,VBA,VBScriptのための実践&リファレンスADO』アプライドナレッジの Rem 「第3部 ADOの活用 第2章 VBA」 Rem  佐藤信正『VBScript実用プログラミング・テクニック』メディア・テック出版の Rem 「Part5 [16]12万件の郵便番号を検索する」 Rem 4. 「DBPath」にコロン区切り形式ファイルの保存先フォルダを指定すること。 Rem (既定値は「EspRevizo」の「pejvo-s.txt」ファイルの保存先) Rem 5. SQL文使用には、ファイル名にハイフンが使えないため、(已むを得ず) Rem 「pejvo-s.txt」ファイルをコピーし、ファイル名のハイフンをアンダーバーに変更してから、 Rem このマクロを実行すること。「pejvo-s.txt」→「pejvo_s.txt」 Rem 6. 初回実行前に、コロン区切り形式ファイルの保存先フォルダに「schema.ini」ファイルを作成しておくこと。 Rem (「EspVortizoSchemaIni」を初回実行前に先行して、一度だけ実行する。) Rem 7. このマクロの一部に下記の「Espizo」「EspRevizo」のプロシージャを使用している。 Rem EspizoAeiou・EspizoCghjsu・EspizoOthers・ Rem EspizoRvAeiou・EspizoRvCghjsu・EspizoRvOthers・ Rem EspRevizoConst Rem 8. Win32 APIを利用:GetAsyncKeyState関数。 Rem 不具合あり。 Rem 1. EspizoSuff実行後に、カーソル位置が選択範囲の末尾より1〜2文字分左になることがある。 Rem 2. 文章が頁を跨いだ場合、文章入力時に画面が上下してチラつきが発生する。 Rem 「.」で文章を区切るか、スクロールバーを上下させて表示位置を変えるなどの対処が必要。 Rem 履歴... Rem 第01版:2007/10/04:作成。 Rem 第02版:2007/11/13:[選択して下さい。]ボタン処理を追加。 Rem 第03版:2008/01/03:[IEに表示する]ボタン処理を追加。 Rem 第04版:2008/05/20:Espizoの機能を追加。 Rem 第05版:2008/08/28:FaceIdを変更。(1611=>1063 252=>284) Rem 第06版:2008/09/20:[あいまい検索設定]ボタンを追加。 Rem 第07版:2008/11/01... Rem [PEJVO 辞書ファイル 照会処理を実行!]時に、字上符のない単語を検索する際に、 Rem 字上符の付いた単語を表示しないように変更。 Rem 第08版:2008/12/01... Rem 当マクロの一部の機能を、Windows音声認識で起動できるようにするため、 Rem ツールバーのCaptionプロパティ指定を変更。 Rem 第09版:2009/04/01... Rem 打鍵起動処理を追加。[Space]キーを押すと、 Rem カーソルより前の一つの文章にある代用文字を正書文字に置換する。 Rem [^x記法]時には[X]キーを押すと、即時に置換する。 Rem 第10版:2009/05/05:EspizoAutoLoopプロシージャのSelect Case文にDoEventsを追加。 Rem 第11版:2009/05/10:打鍵起動処理の内、[Space]キーでの処理を[Pause]キーで処理するよう変更。 Rem *----*----* *----*----* *----*----* *----*----* Rem 参照設定する場合... Rem Microsoft ActiveX Data Objects 2.8 Library Rem Microsoft Internet Controls Rem *----*----* *----*----* *----*----* *----*----* Dim myTitle As String Rem *----*----* *----*----* *----*----* *----*----* ' Rem 既定値の設定 myTitle = "EspVortizo" Rem *----*----* *----*----* *----*----* *----*----* ' Rem ステータスバーの表示 Application.DisplayStatusBar = True ' Call EspVortizoBlln(myTitle) End Sub ' EspVortizo *----*----* *----*----* *----*----* *----*----* Sub EspVortizoBlln(myTitle As String) Rem *----*----* *----*----* *----*----* *----*----* Rem ツールバー表示処理 Rem *----*----* *----*----* *----*----* *----*----* Dim myCmmdBar As CommandBar Dim myAutoEspizo As CommandBarControl Dim myBttnEspizo As CommandBarControl Dim myCkboxEspizo As CommandBarControl Dim myBttnMatchFuzzy As CommandBarControl Dim myBttnVortizo As CommandBarControl Rem *----*----* *----*----* *----*----* *----*----* ' Rem 同名ツールバーの削除 On Error Resume Next CommandBars(myTitle).Delete On Error GoTo 0 ' Set myCmmdBar = CommandBars.Add(Name:=myTitle, Position:=msoBarTop, Temporary:=True) Set myAutoEspizo = myCmmdBar.Controls.Add(Type:=msoControlButton, Before:=1, Temporary:=True) Set myBttnEspizo = myCmmdBar.Controls.Add(Type:=msoControlButton, Before:=2, Temporary:=True) Set myCkboxEspizo = myCmmdBar.Controls.Add(Type:=msoControlDropdown, Before:=3, Temporary:=True) ' Set myCkboxEspizo = myCmmdBar.Controls.Add(Type:=msoControlComboBox, Before:=3, Temporary:=True) Set myBttnMatchFuzzy = myCmmdBar.Controls.Add(Type:=msoControlButton, Before:=4, Temporary:=True) Set myBttnVortizo = myCmmdBar.Controls.Add(Type:=msoControlButton, Before:=5, Temporary:=True) Rem *----*----* *----*----* *----*----* *----*----* ' With myAutoEspizo .DescriptionText = "エスペラント語 代用文字 範囲内置換:選択した処理をキーを押して起動します。" .Style = msoButtonIcon .Caption = "エス文字 文字列の置き換え 打鍵起動" .TooltipText = "[ 文字列の置き換え打鍵起動!]" .FaceId = 6917 .OnAction = myTitle & "AutoEspizo" End With ' With myBttnEspizo .DescriptionText = "エスペラント語 代用文字 範囲内 置換処理:選択した処理を実行します。" .Style = msoButtonIcon .Caption = "エス文字 文字列の置き換え" .TooltipText = "[ 文字列の置き換え実行!]" ' "代用文字 範囲内 置換処理を実行!" .FaceId = 1063 .OnAction = myTitle & "BttnEspizo" End With ' With myCkboxEspizo .DescriptionText = "実行する処理を選択します。" .Style = msoComboNormal .Caption = "表記法選択" ' .AddItem "^x記法", 1 .AddItem "^記法", 2 .AddItem "&;記法", 3 .AddItem "^’記法", 4 .AddItem "^h記法", 5 .AddItem "===========", 6 .AddItem "x代用表記", 7 .AddItem "^代用表記", 8 .AddItem "&;代用表記", 9 .AddItem "===========", 10 .AddItem "^接頭字記法", 11 ' .ListIndex = 1 .TooltipText = "^x記法" .DropDownLines = 11 .DropDownWidth = 200 .OnAction = myTitle & "CkboxEspizo" End With ' With myBttnMatchFuzzy .DescriptionText = "PEJVO 辞書ファイル 照会処理:[あいまい検索設定]ボタン" .BeginGroup = True .Style = msoButtonIcon .Caption = "検索方法の指定" .TooltipText = "単語と訳語を 前後あいまい検索します。" .FaceId = 2525 .OnAction = myTitle & "BttnMatchFuzzy" .Parameter = "" End With ' With myBttnVortizo .DescriptionText = "PEJVO 辞書ファイル 照会処理:処理を実行します。" .BeginGroup = True .Style = msoButtonIcon .Caption = "字引き 辞書の照会" .TooltipText = "[ 辞書の照会! ]" ' "PEJVO 辞書ファイル 照会処理を実行!" .FaceId = 284 .OnAction = myTitle & "BttnVortizo" .Parameter = "0,1,2,3,4,289" End With ' myCmmdBar.Visible = True End Sub ' EspVortizoBlln *----*----* *----*----* *----*----* *----*----* Sub EspVortizoCkboxEspizo(Optional myDummy As Boolean) Rem *----*----* *----*----* *----*----* *----*----* Rem [処理]コンボボックス処理 Rem *----*----* *----*----* *----*----* *----*----* With CommandBars("EspVortizo").Controls(3) If .Text = "===========" Then .TooltipText = "処理が未選択です。" Else If .Text = "&;記法" Or .Text = "&;代用表記" Then .TooltipText = "&" & .Text Else .TooltipText = .Text End If End If End With End Sub ' EspVortizoCkboxEspizo *----*----* *----*----* *----*----* *----*----* Sub EspVortizoAutoEspizo(Optional myDummy As Boolean) Rem *----*----* *----*----* *----*----* *----*----* Rem 自動実行ボタン処理 Rem *----*----* *----*----* *----*----* *----*----* With CommandBars("EspVortizo").Controls(1) If .FaceId = 6917 Then .FaceId = 6914 .TooltipText = "打鍵起動 処理中。 実行:[x]/[Pause]キー 終了:[Esc]キー" Call EspVortizoAutoLoop("EspVortizo") Else .FaceId = 6917 .TooltipText = "[ 文字列の置き換え打鍵起動!]" End If End With End Sub ' EspVortizoAutoEspizo *----*----* *----*----* *----*----* *----*----* Sub EspVortizoBttnEspizo(Optional myDummy As Boolean) Rem *----*----* *----*----* *----*----* *----*----* Rem 各ボタン処理 Rem *----*----* *----*----* *----*----* *----*----* Dim myTitle As String Dim myBttn As Long Dim myLabel As String Dim c As Long Rem *----*----* *----*----* *----*----* *----*----* ' myTitle = "EspVortizo" ' With CommandBars(myTitle).Controls(3) myLabel = .Text myBttn = .ListIndex End With Rem *----*----* *----*----* *----*----* *----*----* ' Select Case myBttn Case 0, 6, 10 GoTo EspVortizoBttnEspizoSubExit End Select Rem *----*----* *----*----* *----*----* *----*----* ' Application.ScreenUpdating = False ' If Selection.Range.Text = "" Then c = Selection.MoveUp(wdParagraph, 1, wdExtend) If c = 0 Then GoTo EspVortizoBttnEspizoSubExit End If End If Rem *----*----* *----*----* *----*----* *----*----* ' EspVortizoBttnEspizoSubEntry: Select Case myBttn Case 1 Call EspVortizoSffx("x") Case 2 Call EspVortizoSffx("^") Case 3 Call EspVortizoUcs2 Case 4 Call EspVortizoSffx("'") Case 5 Call EspVortizoSffx("h") Case 7 Call EspVortizoSuff("x") Case 8 Call EspVortizoSuff("^") Case 9 Call EspVortizoSuff("") Case 11 Call EspVortizoPrfx("^") ' ^接頭字記法 End Select Rem *----*----* *----*----* *----*----* *----*----* ' EspVortizoBttnEspizoSubExit: Selection.Collapse wdCollapseEnd ' Rem 続けて処理する場合に備える。(〜Excel 2003) If Val(Application.Version) < 12 Then CommandBars(myTitle).Enabled = False CommandBars(myTitle).Enabled = True End If ' Application.ScreenUpdating = True ' Select Case myBttn Case 1 To 5, 7 To 9, 11 Application.StatusBar = myTitle & ":" & "処理完了!" & "[ " & myLabel & " ]" End Select End Sub ' EspVortizoBttnEspizo *----*----* *----*----* *----*----* *----*----* Sub EspVortizoAutoLoop(myTitle As String) Do If CommandBars(myTitle).Controls(1).FaceId = 6917 Then Exit Do ' Select Case True Case GetAsyncKeyState(vbKeyX) <> 0 DoEvents If CommandBars(myTitle).Controls(3).Text = "^x記法" Then CommandBars(myTitle).Controls(1).FaceId = 2151 Application.ScreenUpdating = False Selection.MoveLeft Unit:=wdCharacter, Count:=2, Extend:=wdExtend Call EspVortizoBttnEspizo Application.ScreenUpdating = True CommandBars(myTitle).Controls(1).FaceId = 6914 End If Case GetAsyncKeyState(vbKeyPause) <> 0 DoEvents CommandBars(myTitle).Controls(1).FaceId = 2151 Application.ScreenUpdating = False Selection.MoveLeft Unit:=wdSentence, Count:=1, Extend:=wdExtend Call EspVortizoBttnEspizo Application.ScreenUpdating = True CommandBars(myTitle).Controls(1).FaceId = 6914 Case GetAsyncKeyState(vbKeyEscape) <> 0 DoEvents CommandBars(myTitle).Controls(1).FaceId = 6917 CommandBars(myTitle).Controls(1).TooltipText = "[ 文字列の置き換え打鍵起動!]" Exit Do End Select ' DoEvents Loop End Sub ' EspVortizoAutoLoop *----*----* *----*----* *----*----* *----*----* Sub EspVortizoSffx(mySffx As String) Rem *----*----* *----*----* *----*----* *----*----* Rem 各接尾字記法処理 Rem mySffxの値... Rem 「^」の場合:^接尾字付き文字を置換する。 Rem 「x」の場合:^接尾字付き文字・x接尾字付き文字ともに置換する。 Rem 「'」の場合:^接尾字付き文字・'接尾字付き文字ともに置換する。 Rem 「h」の場合:^接尾字付き文字・h接尾字付き文字ともに置換する。 Rem 注記... Rem 参照設定する場合:Microsoft VBScript Regular Expressions 5.5 Rem *----*----* *----*----* *----*----* *----*----* ' If Selection.Range.Characters.Count < 2 Then Exit Sub ' Dim i As Long Dim C As Integer ' Dim myRange As Range Dim myChrsFound As Characters Dim myText As String Dim myLen As Long ' Dim myRegExp As Variant ' VBScript_RegExp_55.RegExp Dim myMatches As Variant ' MatchCollection Dim myMatch As Variant ' Match Dim myPttn As String ' Set myRegExp = CreateObject("VBScript.RegExp") ' New VBScript_RegExp_55.RegExp Set myRange = Selection.Range Selection.Collapse wdCollapseStart ' EspVortizoSffxSubEntry: Rem パターンを設定 Select Case mySffx Case "x" myPttn = "([AEIOaeio]{1}[\_\^]{1})|([Uu]{1}[\_~]{1})|([CGHJSUcghjsu]{1}[x\^]{1})" Case "^" myPttn = "([AEIOaeio]{1}[\_\^]{1})|([Uu]{1}[\_~]{1})|([CGHJSUcghjsu]{1}[\^]{1})" Case "'" myPttn = "([AEIOaeio]{1}[\_\^]{1})|([Uu]{1}[\_~]{1})|([CGHJSUcghjsu]{1}[\u0027\u2019\^]{1})" Case "h" myPttn = "([AEIOaeio]{1}[\_\^]{1})|([Uu]{1}[\_~]{1})|([CGHJSUcghjsu]{1}[h\^]{1})" End Select ' With myRegExp .Pattern = myPttn ' パターンを指定 .IgnoreCase = False ' 大文字小文字を区別する。 .Global = True ' 文字列全体を検索 End With Set myMatches = myRegExp.Execute(myRange.Text) ' If myMatches.Count = 0 Then GoTo EspVortizoSffxSubExit ' 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 ' Set myChrsFound = Selection.Range.Characters myText = myChrsFound.Parent.Text myLen = Len(myText) ' Select Case myChrsFound.First.Next.Text Case "^" Select Case myChrsFound.First.Text Case "C", "G", "H", "J", "S", "U", "c", "g", "h", "j", "s", "u" Call EspizoCghjsu("", "^", myText) Case "A", "E", "I", "O", "a", "e", "i", "o" Call EspizoAeiou("", "^", myText) End Select Case "x" Select Case myChrsFound.First.Text Case "C", "G", "H", "J", "S", "U", "c", "g", "h", "j", "s", "u" Call EspizoCghjsu("", "x", myText) End Select Case "'", ChrW(8217) ' 単一引用符 Select Case myChrsFound.First.Text Case "C", "G", "H", "J", "S", "U", "c", "g", "h", "j", "s", "u" Call EspizoCghjsu("", "'", myText) Call EspizoCghjsu("", ChrW(8217), myText) End Select Case "h" Select Case myChrsFound.First.Text Case "C", "G", "H", "J", "S", "U", "c", "g", "h", "j", "s", "u" Call EspizoCghjsu("", "h", myText) End Select Case "_" Select Case myChrsFound.First.Text Case "A", "E", "I", "O", "U", "a", "e", "i", "o", "u" Call EspizoAeiou("", "_", myText) End Select Case "~" Select Case myChrsFound.First.Text Case "U", "u" Call EspizoCghjsu("", "^", myText) End Select End Select ' If myLen <> Len(myText) Then Rem 置換する文字列があった場合。 myChrsFound.First.Text = myText myChrsFound.First.Next.Text = "" End If ' C = Int((i + 1) * 100 / myMatches.Count) Application.StatusBar = "EspVortizo" & ":処理中" & " " & Format(C, "##0") & "%" Next ' i End With ' EspVortizoSffxSubExit: myRange.Select ' 当初の選択範囲。 Selection.Collapse wdCollapseEnd ' Set myRegExp = Nothing Set myMatches = Nothing ' Set myRange = Nothing Set myChrsFound = Nothing End Sub ' EspVortizoSffx *----*----* *----*----* *----*----* *----*----* Sub EspVortizoUcs2(Optional myDummy As Boolean) Rem *----*----* *----*----* *----*----* *----*----* Rem 十進符号記法処理 Rem 「&〜;」(UCS_2十進符号表記)を検索し、文字列を置換する。 Rem 注記... Rem 参照設定する場合:Microsoft VBScript Regular Expressions 5.5 Rem *----*----* *----*----* *----*----* *----*----* ' If Selection.Range.Characters.Count < 3 Then Exit Sub ' Dim i As Long Dim j As Integer Dim C As Integer ' Dim myRange As Range Dim myChrsFound As Characters Dim myText As String Dim myLen As Long ' Dim myRegExp As Variant ' VBScript_RegExp_55.RegExp Dim myMatches As Variant ' MatchCollection Dim myMatch As Variant ' Match ' Set myRegExp = CreateObject("VBScript.RegExp") ' New VBScript_RegExp_55.RegExp Set myRange = Selection.Range Selection.Collapse wdCollapseStart ' EspVortizoUcs2SubEntry: With myRegExp .Pattern = "\&{1}[\#A-Za-z0-9]{1,10}\;{1}" ' 「&〜;」を指定 .IgnoreCase = False ' 大文字小文字を区別する。 .Global = True ' 文字列全体を検索 End With Set myMatches = myRegExp.Execute(myRange.Text) ' If myMatches.Count = 0 Then GoTo EspVortizoUcs2SubExit ' 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 ' Set myChrsFound = Selection.Range.Characters myText = myChrsFound.Parent.Text myLen = Len(myText) ' Call EspizoUcAeiou(myText) Call EspizoUcCghjsu(myText) Call EspizoUcOthers(myText) ' If myLen <> Len(myText) Then Rem 置換する文字列があった場合。 Rem myChrsFound.Parent.Text = myText ' 不可! Rem ↑文字列の最後に置換する文字がある場合、 Rem 処理後のカーソル位置がズレる。(↓苦肉の策!) myChrsFound.First.Text = myText For j = 2 To myLen myChrsFound.First.Next.Text = "" Next ' j End If ' C = Int((i + 1) * 100 / myMatches.Count) Application.StatusBar = "EspVortizo" & ":処理中" & " " & Format(C, "##0") & "%" Next ' i End With ' EspVortizoUcs2SubExit: myRange.Select ' 当初の選択範囲。 Selection.Collapse wdCollapseEnd ' Set myRegExp = Nothing Set myMatches = Nothing ' Set myRange = Nothing Set myChrsFound = Nothing End Sub ' EspVortizoUcs2 *----*----* *----*----* *----*----* *----*----* Sub EspVortizoSuff(mySffx As String) Rem *----*----* *----*----* *----*----* *----*----* Rem 代用文字表記処理 Rem 各国文字など各種の文字(Unicodeで160〜511の範囲)を検索し、 Rem (1):検索した文字列を、UCS_2十進表記に置換する。 Rem (2):エスペラント語文字を、指定した文字列接尾字付きの文字列に置換する。 Rem (3):屈音符付き母音字は、「_」接尾字付き文字列に置換する。 Rem mySffxの値... Rem 「」の場合:検索した総ての文字列を対象に(1)処理。 Rem 「^」の場合:(3)処理をし、(2)処理で「^」接尾字付きの文字列に置換する。 Rem 「x」の場合:(3)処理をし、(2)処理で「x」接尾字付きの文字列に置換する。 Rem 注記... Rem 参照設定する場合:Microsoft VBScript Regular Expressions 5.5 Rem *----*----* *----*----* *----*----* *----*----* ' If Selection.Range.Characters.Count < 1 Then Exit Sub ' Dim i As Long Dim C As Integer ' Dim myRange As Range Dim myChrsFound As Characters Dim myText As String Dim myLen As Long ' Dim myRegExp As Variant ' VBScript_RegExp_55.RegExp Dim myMatches As Variant ' MatchCollection Dim myMatch As Variant ' Match ' Set myRegExp = CreateObject("VBScript.RegExp") ' New VBScript_RegExp_55.RegExp Set myRange = Selection.Range ' Selection.Collapse wdCollapseStart ' EzpizoSuffSubEntry: With myRegExp .Pattern = "[" & ChrW(160) & "-" & ChrW(511) & "]{1}" .IgnoreCase = False ' 大文字小文字を区別する。 .Global = True ' 文字列全体を検索 End With Set myMatches = myRegExp.Execute(myRange.Text) ' If myMatches.Count = 0 Then GoTo EzpizoSuffSubExit ' 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 ' Set myChrsFound = Selection.Range.Characters myText = myChrsFound.Parent.Text myLen = Len(myText) ' If mySffx = "" Then Call EspizoRvOthers(myText) Else Select Case myText Case ChrW(194), ChrW(202), ChrW(206), ChrW(212), ChrW(219) Call EspizoRvAeiou("", "_", myText) Case ChrW(226), ChrW(234), ChrW(238), ChrW(244), ChrW(251) Call EspizoRvAeiou("", "_", myText) Case ChrW(264), ChrW(284), ChrW(292), ChrW(308), ChrW(348), ChrW(364) Call EspizoRvCghjsu("", mySffx, myText) Case ChrW(265), ChrW(285), ChrW(293), ChrW(309), ChrW(349), ChrW(365) Call EspizoRvCghjsu("", mySffx, myText) Case Else Call EspizoRvOthers(myText) End Select End If ' If myLen <> Len(myText) Then Rem 置換する文字列があった場合。 myChrsFound.Parent.Text = myText End If Call Selection.MoveRight(wdCharacter, Len(myText), wdMove) ' C = Int((i + 1) * 100 / myMatches.Count) Application.StatusBar = "EspVortizo" & ":処理中" & " " & Format(C, "##0") & "%" Next ' i End With ' EzpizoSuffSubExit: myRange.Select ' 当初の選択範囲。 Selection.Collapse wdCollapseEnd ' Set myRegExp = Nothing Set myMatches = Nothing ' Set myRange = Nothing Set myChrsFound = Nothing End Sub ' EspVortizoSuff *----*----* *----*----* *----*----* *----*----* Sub EspVortizoPrfx(myPrfx As String) Rem *----*----* *----*----* *----*----* *----*----* Rem 各接頭尾字記法処理 Rem myPrfxの値... Rem 「^」の場合:^接尾字付き文字を置換する。 Rem 注記... Rem 参照設定する場合:Microsoft VBScript Regular Expressions 5.5 Rem *----*----* *----*----* *----*----* *----*----* ' If Selection.Range.Characters.Count < 2 Then Exit Sub ' Dim i As Long Dim C As Integer ' Dim myRange As Range Dim myChrsFound As Characters Dim myText As String Dim myLen As Long ' Dim myRegExp As Variant ' VBScript_RegExp_55.RegExp Dim myMatches As Variant ' MatchCollection Dim myMatch As Variant ' Match Dim myPttn As String ' Set myRegExp = CreateObject("VBScript.RegExp") ' New VBScript_RegExp_55.RegExp Set myRange = Selection.Range Selection.Collapse wdCollapseStart ' EspVortizoPrfxSubEntry: Rem パターンを設定 Select Case myPrfx Case "^" myPttn = "([\_\^]{1}[AEIOaeio]{1})|([\_~]{1}[Uu]{1})|([\^]{1}[CGHJSUcghjsu]{1})" End Select ' With myRegExp .Pattern = myPttn ' パターンを指定 .IgnoreCase = False ' 大文字小文字を区別する。 .Global = True ' 文字列全体を検索 End With Set myMatches = myRegExp.Execute(myRange.Text) ' If myMatches.Count = 0 Then GoTo EspVortizoPrfxSubExit ' With Selection.Find For i = 0 To myMatches.Count - 1 .ClearFormatting If Left(myMatches.Item(i).Value, 1) = "^" Then .Text = "^" & myMatches.Item(i).Value Else .Text = myMatches.Item(i).Value End If .Forward = True .Wrap = wdFindStop .MatchCase = True .MatchAllWordForms = False .MatchSoundsLike = False .MatchFuzzy = False .MatchWildcards = False .Execute ' Set myChrsFound = Selection.Range.Characters myText = myChrsFound.Parent.Text myLen = Len(myText) ' Select Case myChrsFound.First.Text Case "^" Select Case myChrsFound.Last.Text Case "C", "G", "H", "J", "S", "U", "c", "g", "h", "j", "s", "u" Call EspizoCghjsu("^", "", myText) Case "A", "E", "I", "O", "a", "e", "i", "o" Call EspizoAeiou("^", "", myText) End Select Case "_" Select Case myChrsFound.Last.Text Case "A", "E", "I", "O", "U", "a", "e", "i", "o", "u" Call EspizoAeiou("_", "", myText) End Select Case "~" Select Case myChrsFound.Last.Text Case "U", "u" Call EspizoCghjsu("^", "", myText) End Select End Select ' If myLen <> Len(myText) Then Rem 置換する文字列があった場合。 myChrsFound.First.Text = myText myChrsFound.First.Next.Text = "" End If ' C = Int((i + 1) * 100 / myMatches.Count) Application.StatusBar = "EspVortizo" & ":処理中" & " " & Format(C, "##0") & "%" Next ' i End With ' EspVortizoPrfxSubExit: myRange.Select ' 当初の選択範囲。 Selection.Collapse wdCollapseEnd ' Set myRegExp = Nothing Set myMatches = Nothing ' Set myRange = Nothing Set myChrsFound = Nothing End Sub ' EspVortizoPrfx *----*----* *----*----* *----*----* *----*----* Sub EspVortizoBttnMatchFuzzy(Optional myDummy As Boolean) Rem *----*----* *----*----* *----*----* *----*----* Rem [あいまい検索設定]ボタン処理 Rem *----*----* *----*----* *----*----* *----*----* Dim myTitle As String Dim myParameter As Variant Rem *----*----* *----*----* *----*----* *----*----* ' myTitle = "EspVortizo" With CommandBars(myTitle).Controls(4) Select Case .FaceId Case 2525 .FaceId = 2526 .TooltipText = "単語を 前方一致で 検索します。" Case 2526 .FaceId = 2527 .TooltipText = "単語を 後方一致で 検索します。" Case 2527 .FaceId = 2525 .TooltipText = "単語と訳語を 前後あいまい検索します。" End Select End With End Sub ' EspVortizoBttnMatchFuzzy *----*----* *----*----* *----*----* *----*----* Sub EspVortizoBttnVortizo(Optional myDummy As Boolean) Dim myConn As Variant ' ADODB.Connection Dim myRecSet As Variant ' ADODB.Recordset Dim DBPath As String Dim CsvDB As String Dim myDicPcase As String Dim myDicLcase As String Dim mySQL As String ' Dim myTitle As String Dim myFlag As Boolean Dim i As Long Dim j As Long Dim myStatusBar As String ' Dim myRange As Range Dim myText As String Dim myFindSurrogate As String Dim myFindOrtho As String Dim myItem As String Dim myItemColumn As String Dim myWord As String Rem *----*----* *----*----* *----*----* *----*----* ' Rem 既定値の設定 myTitle = "EspVortizo" Call EspRevizoConst("myFolder", DBPath) Call EspRevizoConst("myDicPejvo", CsvDB) Call EspRevizoConst("myDicPcase", myDicPcase) Call EspRevizoConst("myDicLcase", myDicLcase) Rem *----*----* *----*----* *----*----* *----*----* ' Set myRange = Selection.Range myText = Selection.Range.Text Call EspVortizoDelString(myText) myFindOrtho = Trim(myText) myFindSurrogate = myFindOrtho Call EspizoRvAeiou("", "_", myFindSurrogate) Call EspizoRvCghjsu("", "^", myFindSurrogate) Call EspizoRvOthers(myFindSurrogate) myFindSurrogate = Replace(myFindSurrogate, "^", "[^]") myFindSurrogate = Replace(myFindSurrogate, "_", "[_]") ' If myText = "" Then Exit Sub 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 *----*----* *----*----* *----*----* *----*----* ' EspVortizoBttnSubEntry: With CommandBars(myTitle).Controls(4) Select Case .FaceId Case 2525 Rem 単語と訳語を 前後あいまい検索します。 mySQL = "Select 単語 & ' : ' & 訳語 From " & CsvDB & " " mySQL = mySQL & "Where 単語 Like '%" & myFindSurrogate & "%' " mySQL = mySQL & "Or 訳語 Like '%" & myFindSurrogate & "%' " mySQL = mySQL & " Union All " mySQL = mySQL & "Select 単語 & ' : ' & 訳語 From " & myDicPcase & " " mySQL = mySQL & "Where 単語 Like '%" & myFindSurrogate & "%' " mySQL = mySQL & "Or 訳語 Like '%" & myFindSurrogate & "%' " mySQL = mySQL & " Union All " mySQL = mySQL & "Select 単語 & ' : ' & 訳語 From " & myDicLcase & " " mySQL = mySQL & "Where 単語 Like '%" & myFindSurrogate & "%' " mySQL = mySQL & "Or 訳語 Like '%" & myFindSurrogate & "%'; " Case 2526 Rem 単語を 前方一致で 検索します。 mySQL = "Select 単語 & ' : ' & 訳語 From " & CsvDB & " " mySQL = mySQL & "Where 単語 Like '" & myFindSurrogate & "%' " mySQL = mySQL & " Union All " mySQL = mySQL & "Select 単語 & ' : ' & 訳語 From " & myDicPcase & " " mySQL = mySQL & "Where 単語 Like '" & myFindSurrogate & "%' " mySQL = mySQL & " Union All " mySQL = mySQL & "Select 単語 & ' : ' & 訳語 From " & myDicLcase & " " mySQL = mySQL & "Where 単語 Like '" & myFindSurrogate & "%'; " Case 2527 Rem 単語を 後方一致で 検索します。 mySQL = "Select 単語 & ' : ' & 訳語 From " & CsvDB & " " mySQL = mySQL & "Where 単語 Like '%" & myFindSurrogate & "' " mySQL = mySQL & " Union All " mySQL = mySQL & "Select 単語 & ' : ' & 訳語 From " & myDicPcase & " " mySQL = mySQL & "Where 単語 Like '%" & myFindSurrogate & "' " mySQL = mySQL & " Union All " mySQL = mySQL & "Select 単語 & ' : ' & 訳語 From " & myDicLcase & " " mySQL = mySQL & "Where 単語 Like '%" & myFindSurrogate & "'; " End Select End With ' Rem テーブルへの参照を取得 With myRecSet .ActiveConnection = myConn .Source = mySQL .Open End With ' Call EspVortizoCmmdBar(myTitle & "Bttn") ' Rem フィールド名を転記 'For i = 1 To myRecSet.Fields.Count ' Selection.TypeText Text:=myRecSet.Fields(i - 1).Name & " " 'Next ' i ' j = 0 Rem レコードを転記 Do While Not myRecSet.EOF myItem = "" For i = 1 To myRecSet.Fields.Count myItemColumn = myRecSet.Fields(i - 1).Value ' & vbCr Call EspizoAeiou("", "_", myItemColumn) Call EspizoCghjsu("", "^", myItemColumn) Call EspizoUcOthers(myItemColumn) myItem = myItem & myItemColumn Next ' i ' myFlag = False With CommandBars(myTitle).Controls(4) Select Case .FaceId Case 2525 Rem 単語と訳語を 前後あいまい検索します。 If InStr(myItem, myFindOrtho) > 0 Then myFlag = True End If Case 2526 Rem 単語を 前方一致で 検索します。 myWord = Left(myItem, InStr(myItem, " : ") - 1) If Left(myWord, Len(myFindOrtho)) = myFindOrtho Then myFlag = True End If Case 2527 Rem 単語を 後方一致で 検索します。 myWord = Left(myItem, InStr(myItem, " : ") - 1) If Right(myWord, Len(myFindOrtho)) = myFindOrtho Then myFlag = True End If End Select End With ' If myFlag = True Then j = j + 1 With CommandBars(myTitle & "Bttn").Controls(2) .AddItem myItem, j .DropDownLines = j .ListIndex = 1 End With End If ' myRecSet.MoveNext Loop ' Beep Call EspVortizoPopUp(myTitle & "Bttn", j, myFindOrtho) Rem *----*----* *----*----* *----*----* *----*----* ' EspVortizoBttnSubExit: Rem 接続を閉じる On Error Resume Next myRecSet.Close myConn.Close CommandBars(myTitle & "Bttn").Delete On Error GoTo 0 Set myRange = Nothing Set myConn = Nothing Set myRecSet = Nothing End Sub ' EspVortizoBttnVortizo *----*----* *----*----* *----*----* *----*----* Sub EspVortizoDelString(myText As String) Rem *----*----* *----*----* *----*----* *----*----* Rem 不要文字列除外処理 Rem *----*----* *----*----* *----*----* *----*----* myText = Replace(myText, vbTab, "") myText = Replace(myText, vbCrLf, "") myText = Replace(myText, vbVerticalTab, "") myText = Replace(myText, vbCr, "") myText = Replace(myText, vbLf, "") myText = Replace(myText, " ", "") myText = Replace(myText, " ", "") End Sub ' EspVortizoDelString *----*----* *----*----* *----*----* *----*----* Sub EspVortizoPopUp(myTitle As String, j As Long, myFind As String) Rem *----*----* *----*----* *----*----* *----*----* Rem リストボックス表示処理 Rem *----*----* *----*----* *----*----* *----*----* Dim myMsg As String Dim myText As String Dim myStatusBar As String Dim i As Long Dim x As Long Dim y As Long Dim myFaceId As Long ' Dim myIE As Variant ' InternetExplorer Rem *----*----* *----*----* *----*----* *----*----* ' If j <= 0 Then Selection.Collapse wdCollapseStart myStatusBar = "該当するデータは、ありません。" Application.StatusBar = Replace(myTitle, "Bttn", "") & ":" & myStatusBar Exit Sub End If ' myStatusBar = "該当するデータが、" & j & "件ありました。" Application.StatusBar = Replace(myTitle, "Bttn", "") & ":" & myStatusBar ' myMsg = "該当するデータが、" & vbCrLf & j & "件ありました。" myMsg = myMsg & vbCrLf & vbCrLf myMsg = myMsg & "リストボックスから" myMsg = myMsg & "選択して下さい。" & Space(10) CommandBars(myTitle).Controls(1).Caption = myMsg x = -1: y = -1 myFaceId = CommandBars(myTitle).Controls(1).FaceId Do On Error Resume Next If x = -1 Then CommandBars(myTitle).ShowPopup Else CommandBars(myTitle).ShowPopup x, y End If On Error GoTo 0 DoEvents Select Case CommandBars(myTitle).Controls(1).FaceId Case 459, 64, 330, 1445 ' リストボックス選択/キャンセル/全部書き出す/IEに表示する Exit Do Case 289, 219, 288, 487 ' [書き出す内容]/[選択して下さい。] x = CommandBars(myTitle).Left y = CommandBars(myTitle).Top CommandBars(myTitle).Controls(1).FaceId = myFaceId Case Else x = -1: y = -1 End Select Loop ' Select Case CommandBars(myTitle).Controls(1).FaceId Case 330 ' [キャンセル] Selection.Collapse wdCollapseStart Exit Sub Case 459 ' リストボックス選択 Selection.Collapse wdCollapseEnd myText = CommandBars(myTitle).Controls(2).Text Call EspVortizoSelText(myTitle, myText) Selection.TypeText myText Case 64 ' [全部書き出す] Selection.Collapse wdCollapseEnd For i = 1 To j With CommandBars(myTitle).Controls(2) .ListIndex = i myText = .Text Call EspVortizoSelText(myTitle, myText) End With Selection.TypeText myText & vbCrLf myStatusBar = "文書上に、単語と訳語を書き出し中です。" & " " & i & "/" & j & "件" Application.StatusBar = Replace(myTitle, "Bttn", "") & ":" & myStatusBar Next ' i Selection.TypeBackspace Case 1445 ' [IEに表示する] Set myIE = CreateObject("InternetExplorer.Application") ' With myIE .Navigate "about:blank" .Visible = True Do While .Busy DoEvents Loop DoEvents End With ' myIE.Document.write "<!-- saved from url=(0014)about:internet -->" & vbCrLf myIE.Document.write "<title>EspVortizo: " & myFind & "</title>" & vbCrLf For i = 1 To j With CommandBars(myTitle).Controls(2) .ListIndex = i myText = .Text Call EspVortizoSelText(myTitle, myText) End With myIE.Document.write myText & "<br>" & vbCrLf myStatusBar = "文書上に、単語と訳語を書き出し中です。" & " " & i & "/" & j & "件" Application.StatusBar = Replace(myTitle, "Bttn", "") & ":" & myStatusBar Next ' i End Select ' Beep myStatusBar = "文書上に、単語と訳語を書き出しました。" Application.StatusBar = Replace(myTitle, "Bttn", "") & ":" & myStatusBar End Sub ' EspVortizoPopUp *----*----* *----*----* *----*----* *----*----* Sub EspVortizoSelText(myTitle As String, myText As String) Select Case CommandBars(myTitle).Controls(5).FaceId Case 289 Rem .TooltipText = "単語と訳語の両方を書き出します。" Case 219 Rem .TooltipText = "単語を書き出します。" myText = Left(myText, InStr(myText, " : ") - 1) Case 288 Rem .TooltipText = "訳語を書き出します。" myText = Mid(myText, InStr(myText, " : ") + 3) End Select End Sub ' EspVortizoSelText *----*----* *----*----* *----*----* *----*----* Sub EspVortizoCmmdBar(myTitle As String) Rem *----*----* *----*----* *----*----* *----*----* Rem ポップアップメニュー設定処理 Rem *----*----* *----*----* *----*----* *----*----* Dim myCmmdBar As CommandBar Dim myCtrlIcon As CommandBarControl Dim myCtrlDdwn As CommandBarControl Dim myCtrlAll As CommandBarControl Dim myCtrlCancel As CommandBarControl Dim myCtrlWdwn As CommandBarControl Dim myCtrlIeDoc As CommandBarControl ' Dim myParameter As Variant Dim myText As String Rem *----*----* *----*----* *----*----* *----*----* ' On Error Resume Next CommandBars(myTitle).Delete On Error GoTo 0 Rem *----*----* *----*----* *----*----* *----*----* ' Set myCmmdBar = CommandBars.Add(Name:=myTitle, Position:=msoBarPopup, Temporary:=True) Set myCtrlIcon = myCmmdBar.Controls.Add(Type:=msoControlButton, Before:=1, Temporary:=True) Set myCtrlDdwn = myCmmdBar.Controls.Add(Type:=msoControlDropdown, Before:=2, Temporary:=True) Set myCtrlAll = myCmmdBar.Controls.Add(Type:=msoControlButton, Before:=3, Temporary:=True) Set myCtrlIeDoc = myCmmdBar.Controls.Add(Type:=msoControlButton, Before:=4, Temporary:=True) Set myCtrlWdwn = myCmmdBar.Controls.Add(Type:=msoControlButton, Before:=5, Temporary:=True) Set myCtrlCancel = myCmmdBar.Controls.Add(Type:=msoControlButton, Before:=6, Temporary:=True) Rem *----*----* *----*----* *----*----* *----*----* ' With myCtrlIcon .DescriptionText = "PEJVO辞書ファイル訳語問い合わせ処理" .Style = msoButtonIconAndWrapCaption .Caption = "選択して下さい。" .TooltipText = "該当するデータを選択して下さい。" .FaceId = 1089 .OnAction = myTitle & "Icon" End With ' With myCtrlDdwn .DescriptionText = "PEJVO辞書ファイルのデータをリストボックスから選択させます。" .Style = msoComboNormal ' msoComboLabel .Caption = "" ' "項目:" .TooltipText = "該当する項目を選んで下さい。" .BeginGroup = True ' .DropDownLines = 0 .DropDownWidth = 600 .OnAction = myTitle & "Ddwn" End With ' With myCtrlAll .DescriptionText = "[全件書き出す]ボタン" .Style = msoButtonIconAndCaption .Caption = "全件書き出す" & String(24, " ") .TooltipText = "検索した内容を全件書き出します。" .BeginGroup = True .FaceId = 64 .OnAction = myTitle & "All" End With ' With myCtrlIeDoc .DescriptionText = "[IEに表示する]ボタン" .Style = msoButtonIconAndCaption .Caption = "IEに表示する" & String(24, " ") .TooltipText = "検索した内容をIEに表示します。" .BeginGroup = True .FaceId = 1445 .OnAction = myTitle & "IeDoc" End With ' With myCtrlWdwn .DescriptionText = "[書き出す内容]ボタン" .Style = msoButtonIconAndCaption .BeginGroup = True .OnAction = myTitle & "Wdwn" myParameter = Split(CommandBars(Replace(myTitle, "Bttn", "")).Controls(5).Parameter, ",") Select Case myParameter(5) Case 289 .FaceId = 289 .Caption = "単語:訳語" & String(24, " ") .TooltipText = "単語と訳語の両方を書き出します。" Case 219 .FaceId = 219 .Caption = "単語" & String(24, " ") .TooltipText = "単語を書き出します。" Case 288 .FaceId = 288 .Caption = "訳語" & String(24, " ") .TooltipText = "訳語を書き出します。" End Select End With ' With myCtrlCancel .DescriptionText = "[キャンセル]ボタン" .Style = msoButtonIconAndCaption .Caption = "キャンセル" & String(24, " ") .TooltipText = "処理を中止します。" .BeginGroup = True .FaceId = 330 .OnAction = myTitle & "Cancel" End With End Sub ' EspVortizoCmmdBar *----*----* *----*----* *----*----* *----*----* Sub EspVortizoBttnIcon(Optional myDummy As Boolean) Rem *----*----* *----*----* *----*----* *----*----* Rem [選択して下さい。]ボタン処理 Rem *----*----* *----*----* *----*----* *----*----* Dim myTitle As String ' myTitle = "EspVortizoBttn" CommandBars(myTitle).Controls(1).FaceId = 487 End Sub ' EspVortizoBttnIcon *----*----* *----*----* *----*----* *----*----* Sub EspVortizoBttnDdwn(Optional myDummy As Boolean) Rem *----*----* *----*----* *----*----* *----*----* Rem リストボックス選択処理 Rem *----*----* *----*----* *----*----* *----*----* Dim myTitle As String ' myTitle = "EspVortizoBttn" CommandBars(myTitle).Controls(1).FaceId = 459 End Sub ' EspVortizoBttnDdwn *----*----* *----*----* *----*----* *----*----* Sub EspVortizoBttnAll(Optional myDummy As Boolean) Rem *----*----* *----*----* *----*----* *----*----* Rem [全件書き出す]ボタン処理 Rem *----*----* *----*----* *----*----* *----*----* Dim myTitle As String ' myTitle = "EspVortizoBttn" CommandBars(myTitle).Controls(1).FaceId = 64 End Sub ' EspVortizoBttnAll *----*----* *----*----* *----*----* *----*----* Sub EspVortizoBttnIeDoc(Optional myDummy As Boolean) Rem *----*----* *----*----* *----*----* *----*----* Rem [IEに表示する]ボタン処理 Rem *----*----* *----*----* *----*----* *----*----* Dim myTitle As String ' myTitle = "EspVortizoBttn" CommandBars(myTitle).Controls(1).FaceId = 1445 End Sub ' EspVortizoBttnIeDoc *----*----* *----*----* *----*----* *----*----* Sub EspVortizoBttnWdwn(Optional myDummy As Boolean) Rem *----*----* *----*----* *----*----* *----*----* Rem [書き出す内容]ボタン処理 Rem *----*----* *----*----* *----*----* *----*----* Dim myTitle As String Dim myParameter As Variant Rem *----*----* *----*----* *----*----* *----*----* ' myTitle = "EspVortizoBttn" With CommandBars(myTitle).Controls(5) Select Case .FaceId Case 289 .FaceId = 219 .Caption = "単語" & String(24, " ") .TooltipText = "単語を書き出します。" Case 219 .FaceId = 288 .Caption = "訳語" & String(24, " ") .TooltipText = "訳語を書き出します。" Case 288 .FaceId = 289 .Caption = "単語:訳語" & String(24, " ") .TooltipText = "単語と訳語の両方を書き出します。" End Select End With CommandBars(myTitle).Controls(1).FaceId = CommandBars(myTitle).Controls(5).FaceId myParameter = Split(CommandBars(Replace(myTitle, "Bttn", "")).Controls(5).Parameter, ",") myParameter(5) = CommandBars(myTitle).Controls(5).FaceId CommandBars(Replace(myTitle, "Bttn", "")).Controls(5).Parameter = Join(myParameter, ",") End Sub ' EspVortizoBttnWdwn *----*----* *----*----* *----*----* *----*----* Sub EspVortizoBttnCancel(Optional myDummy As Boolean) Rem *----*----* *----*----* *----*----* *----*----* Rem [キャンセル]ボタン処理 Rem *----*----* *----*----* *----*----* *----*----* Dim myTitle As String ' myTitle = "EspVortizoBttn" CommandBars(myTitle).Controls(1).FaceId = 330 End Sub ' EspVortizoBttnCancel *----*----* *----*----* *----*----* *----*----* Sub EspVortizoSchemaIni() ' (Optional myDummy As Boolean) Rem *----*----* *----*----* *----*----* *----*----* Rem EspVortizo初期設定処理(「schema.ini」ファイルを作成) Rem (「EspVortizo」初回実行前に一度だけ実行) Rem 機能... Rem 1. EspVortizoの初期設定をする。 Rem 見出し情報や内部構造をODBCに伝えるために、 Rem コロン区切り形式ファイルの保存先フォルダに「schema.ini」ファイルを作成する。 Rem 2.「DBPath」にコロン区切り形式ファイルの保存先フォルダを指定すること。 Rem (既定値は「EspRevizo」の「pejvo-s.txt」ファイルの保存先) Rem 3.この処理で「schema.ini」ファイルを作成する。 Rem 注記... Rem 1. コロン区切り形式ファイルを参照する部分を、下記の書籍から引用して、Word VBA用に改変した。 Rem 佐藤信正『VBScript実用プログラミング・テクニック』メディア・テック出版の Rem 「Part5 [16]12万件の郵便番号を検索する」から引用した。 Rem 結城圭介『最速攻略 VBScripサンプル大全集』技術評論社の Rem 「第3章 実践サンプル編 ファイル・フォルダ Rem [3-13]フラットファイルのレイアウトを変更する Rem [3-14]フラットファイルからCSVファイルを作成する」から引用した。 Rem 2.「EspVortizo」初回実行前に先行して一度だけ実行すること。 Rem 3. SQL文使用には、ファイル名にハイフンが使えないため、(已むを得ず) Rem 「pejvo-s.txt」ファイルをコピーし、ファイル名のハイフンをアンダーバーに変更する。 Rem 「pejvo-s.txt」→「pejvo_s.txt」 Rem 4. このマクロの一部に下記の「EspRevizo」のプロシージャを使用している。 Rem EspRevizoConst Rem 履歴... Rem 第01版:2007/10/04 作成。 Rem *----*----* *----*----* *----*----* *----*----* Dim myFso As Variant Dim myFile As Variant ' Dim IniFile As String Dim myFullName As String ' Dim DBPath As String Dim CsvDB As String Dim myDicPcase As String Dim myDicLcase As String ' Dim myTitle As String Dim myStatusBar As String Dim myMsg As String Dim myAns As Long Rem *----*----* *----*----* *----*----* *----*----* ' Rem 既定値の設定 myTitle = "EspVortizoSchemaIni" Call EspRevizoConst("myFolder", DBPath) ' CsvDB = "pejvo_s.txt" ' "pejvo-s.txt" Call EspRevizoConst("myDicPcase", myDicPcase) Call EspRevizoConst("myDicLcase", myDicLcase) ' 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 関連ファイルを作成する。 Set myFile = myFso.CreateTextFile(myFullName) With myFile .WriteLine ("[" & CsvDB & "]") ' .WriteLine ("ColNameHeader=False") .WriteLine ("CharacterSet=oem") .WriteLine ("Format=Delimited(:)") ' .WriteLine ("Col1=単語 Char Width 255") .WriteLine ("Col2=訳語 Char Width 255") .WriteLine (vbCrLf) ' *----*----* *----*----* .WriteLine ("[" & myDicLcase & "]") ' .WriteLine ("ColNameHeader=False") .WriteLine ("CharacterSet=oem") .WriteLine ("Format=Delimited(:)") ' .WriteLine ("Col1=単語 Char Width 255") .WriteLine ("Col2=訳語 Char Width 255") .WriteLine (vbCrLf) ' *----*----* *----*----* .WriteLine ("[" & myDicPcase & "]") ' .WriteLine ("ColNameHeader=False") .WriteLine ("CharacterSet=oem") .WriteLine ("Format=Delimited(:)") ' .WriteLine ("Col1=単語 Char Width 255") .WriteLine ("Col2=訳語 Char Width 255") .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 ' EspVortizoSchemaIni *----*----* *----*----* *----*----* *----*----*
inserted by FC2 system