マクロインストーラーの更新

すでにお気づきの方もいらっしゃったかと思いますが、
以前こちらで紹介したマクロインストーラーを更新いたしました。

ベクターにてインストーラーを公開しております。
使用方法も書かれていますので、ご覧ください。

【前回からの主要な変更点】
インストールするマクロテンプレートを、ダイアログから
指定できるようになりました。

テンプレートフォルダ中の「Normal.dot」ファイルが
表示されないようにしました。（このファイルを移動
したり削除したりすると、現在のワードの設定が
消えてしまいます。今までは、その配慮が足りませんでした。）

お試しください。

Replace関数の例：右クリックでグーグルに活用してみた。

先週のコメントにてKonnoさんから教えていただいたReplace関数
を用いたプログラムです。

以下、ここ１年ほどの、私がつくってきた同じプログラムの改良の過程です。

２００８年８月３日に公開した右クリックでグーグルのテンプレート
に掲載されていたプログラムを初代として、現在までに改良した
４世代を紹介します。（初代以降は、本日初公開）

当初、８０行かけて書いていた「右クリックでグーグル_ワイルドカード検索」
ですが、いろんな学びをへて、今日書いたプログラムはたった４行です。

ご興味がある方、長いですが見比べてみてください。

無駄がたくさんあったプログラムが、ちょっとした知識で変わっていく
過程がみれますね。

自分でも成長を実感できてうれしいかぎりです。

Konnoさん、どうもありがとうございました。

ちなみに、処理スピードですが、体感スピードは全く変わりません。
それが、VBAの楽しいところですね。

ヘルプを活用して新しい関数を使って”高度な”プログラム
をかけなくても、基礎にのっとって、”エラーのない泥臭い”プログラムを
書けば、結果は同じことが得られるんですね。

パソコンの処理性能が上がったおかげで、このような状態なんだと
思います。

私たち初心者プログラマーにはうれしいことですね。

▼第４世代プログラム　２００９年１０月３１日
ポイント　Replace関数の利用（Split関数利用を中止）
Split関数で必要とされていた「半角スペースが選択されていない場合の
エラー処理」が不要になりました。
第３世代で省略した「全角スペース区切り文字列」へも対応します。

結果、２５行→４行

Sub 第４世代_グーグル検索_ワイルドカード()

      Dim phrase As String    '複数の単語の塊
      Dim URL As String       '開きたいサイトのＵＲＬ

      '抽出した単語から検索用のフレーズを作る（半角スペース区切り）
10    phrase = Replace(Selection.Range, " ", "+*+")

      '抽出した単語から検索用のフレーズを作る（全角スペース区切り）
20    phrase = Replace(phrase, "　", "+*+")

30    URL = "http://www.google.co.jp/search?q=%22" & phrase & "%22&lr="
40    ActiveDocument.FollowHyperlink address:=URL, AddHistory:=True

End Sub

▼第３世代プログラム　２００９年７月２６日
ポイント　１００行のSplit関数、１２０行のUBound関数の利用
区切られた単語の数を数える必要がなくなったので、行数削減
半角スペースで区切られた文字列を検索するようにした
以前は対象としていた「全角スペース区切りの文字列の処理」は、
Split関数使用にあたり省略

結果、４５行→２５行へ

Sub 第３世代_グーグル検索_ワイルドカード()

      Dim phrase As String    '複数の単語の塊
      Dim URL As String       '開きたいサイトのＵＲＬ
      Dim SS, SE As Long      '選択した文字列のカーソル位置
      Dim myRange As Range    'レンジオブジェクト
      Dim strWord() As String '半角スペースで区切られた文字列
      Dim i As Integer

10       On Error GoTo vct_グーグル検索_ワイルドカード_Error

20    SS = Selection.Start
30    SE = Selection.End

      'Rangeオブジェクトの設定
40    Set myRange = ActiveDocument.Range

      '選択範囲の最後が改行記号の場合の処理
50    myRange.SetRange Start:=SE - 1, End:=SE

60    If myRange = chr(13) Then
70        SE = SE - 1
80    End If

      '単語の検索（半角・全角スペース以外の文字列を検索します）
90    myRange.SetRange Start:=SS, End:=SE

      '選択したフレーズ中の単語を抽出
      '区切り文字を" "（半角スペース）に設定
100   strWord() = Split(myRange, " ")

      '抽出した単語から検索用のフレーズを作る
110   phrase = strWord(0)

120   For i = 1 To UBound(strWord)
130       phrase = phrase & "+*+" & strWord(i)
140   Next

150   URL = "http://www.google.co.jp/search?q=%22" & phrase & "%22&lr="
160   ActiveDocument.FollowHyperlink address:=URL, AddHistory:=True

170   Set myRange = Nothing

180      On Error GoTo 0
190      Exit Sub

vct_グーグル検索_ワイルドカード_Error:

200   If Err = 9 Then
210       phrase = vbNullString
220       End
230   Else
240       MSGBOX "エラーが発生したため終了します。" & Err
250   End If

End Sub

▼第２世代プログラム ２００９年６月２１日
ポイント　Rangeオブジェクトを利用　考え方は、初代プログラムと同じ。
Selectionオブジェクトにくらべ、プログラム自体の不要な行数が減った。
また、検索ダイアログボックスを初期化する必要がなくなったので、
初代プログラムにあった６７０行～８００行のコードが不要になった。
４０行～７０行は、選択下文字列の最後が改行マーク（vbCr）の場合の処理。

結果、８０行→４５行。

Sub 第２世代_グーグル検索_ワイルドカード()

      Dim phrase As String    '複数の単語の塊
      Dim URL As String       '開きたいサイトのＵＲＬ
      Dim SS, SE As Long      '選択した文字列のカーソル位置
      Dim myRange As Range    'レンジオブジェクト

10    SS = Selection.Start
20    SE = Selection.End

      'Rangeオブジェクトの設定
30    Set myRange = ActiveDocument.Range

      '選択範囲の最後が改行記号の場合の処理
40    myRange.SetRange Start:=SE - 1, End:=SE

50    If myRange = Chr(13) Then
60        SE = SE - 1
70    End If

      '単語の検索（半角・全角スペース以外の文字列を検索します）
80    myRange.SetRange Start:=SS, End:=SS

90    With myRange.Find
100       .Text = "([! 　]{1,})"
110       .Forward = True
120       .Wrap = wdFindStop
130       .MatchByte = True
140       .MatchWildcards = True
150       .Execute
160   End With

      'スペースを選んだ場合はプログラム終了
170   If Not myRange.Find.Found Then
180       MsgBox "スペースで区切られた複数の単語を選択してください。"
190       End
200   End If

      '選択範囲の先頭に単語が含まれない場合にはプログラム終了
210   If myRange.Start <> SS Then
220       MsgBox "スペースで区切られた複数の単語を選択してください。"
230       End
240   End If

      '単語が見つかった場合には、見つかった単語を格納
250   If myRange.Find.Found = True Then phrase = myRange

      '二つめ以降の単語の検索

260   Do
          '次の単語の検索（半角、全角スペース以外の文字列を検索します）
270       myRange.SetRange Start:=myRange.End, End:=myRange.End
280       myRange.Find.Execute
         
290       If myRange.Find.Found = False Then
300           Exit Do
310       Else
              '末尾をそろえるための確認（日本語のとき役に立ちます）
320           If myRange.End > SE Then
330               myRange.End = SE
340           End If
             
350           If myRange.Start >= SE Then
360               Exit Do
370           Else
380               phrase = phrase & "+*+" & myRange
390               myRange.Collapse direction:=wdCollapseEnd
400           End If
410       End If

420   Loop

430   URL = "http://www.google.co.jp/search?q=%22" & phrase & "%22&lr="
440   ActiveDocument.FollowHyperlink address:=URL, AddHistory:=True

450   Set myRange = Nothing

End Sub

▼初代プログラム　２００８年８月３日
ポイント　Selectionオブジェクトにて、全ての処理を実施。
全角スペースまたは半角スペースで区切られた文字列を
一つずつSelectionで探し出して、フレーズを作っています。

Sub 初代_グーグル検索_ワイルドカード()

      Dim word As String      '選択された文字列内の単語ひとつずつ
      Dim Phrase As String    '複数の単語の塊
      Dim URL As String       '開きたいサイトのＵＲＬ
      Dim SS, SE As Long          '選択した文字列の最終カレット位置

10    SS = Selection.Start
20    SE = Selection.End

      '最初の単語の検索

          '単語の検索（半角・全角スペース以外の文字列を検索します）
30        With Selection.Find
40            .Text = "([! 　]{1,})"
50            .Replacement.Text = ""
60            .Forward = True
70            .Wrap = wdFindStop
80            .Format = True
90            .MatchCase = False
100           .MatchWholeWord = False
110           .MatchByte = False
120           .MatchAllWordForms = False
130           .MatchSoundsLike = False
140           .MatchFuzzy = False
150           .MatchWildcards = True
160       End With
         
170       Selection.Find.Execute
         
          'スペースを選んだ場合はプログラム終了
180       If Not Selection.Find.Found Then
190           MsgBox "スペースで区切られた複数の単語を選択してください。"
200           End
210       End If
         
          '単語をひとつ選んだ場合にはプログラム終了
220       If Selection.Start <> SS Then
230           Selection.Start = SS
240           Selection.End = SE
250           MsgBox "スペースで区切られた複数の単語を選択してください。"
260           End
270       End If
         
280       If Selection.Find.Found Then Phrase = Selection

      '二つめ以降の単語の検索

290   Do
          '単語の検索（半角、全角スペース以外の文字列を検索します）
300       With Selection.Find
310           .Text = "([! 　]{1,})"
320           .Replacement.Text = ""
330           .Forward = True
340           .Wrap = wdFindStop
350           .Format = True
360           .MatchCase = False
370           .MatchWholeWord = False
380           .MatchByte = False
390           .MatchAllWordForms = False
400           .MatchSoundsLike = False
410           .MatchFuzzy = False
420           .MatchWildcards = True
430       End With
         
440       Selection.Find.Execute
         
450       If Not Selection.Find.Found Then Exit Do
         
460       If Selection.Find.Found Then
         
470           If Selection.End > SE Then
480               Selection.End = SE '末尾をそろえるための確認（日本語のとき役に立ちます）
490           End If
             
500           If Selection.Start = Selection.End Then
510               Selection.Start = SS
520               Selection.End = SE
530               MsgBox "スペースで区切られた複数の単語を選択してください。"
540               End
             
550           Else
560               word = Selection
570               Selection.Collapse direction:=wdCollapseEnd
580               Phrase = Phrase & "+*+" & word
590               Selection.Start = Selection.End
600               Selection.End = SE
             
610           End If
             
620       End If
         
630       If Selection.Start = SE Then Exit Do

640   Loop

650       URL = "http://www.google.co.jp/search?q=%22" & Phrase & "%22&lr="
660       ActiveDocument.FollowHyperlink address:=URL, NewWindow:=False, AddHistory:=True

          '検索窓をデフォルトの設定に変更
670       With Selection.Find
680           .Text = ""
690           .Replacement.Text = ""
700           .Forward = True
710           .Wrap = wdFindStop
720           .Format = True
730           .MatchCase = False
740           .MatchWholeWord = False
750           .MatchByte = False
760           .MatchAllWordForms = False
770           .MatchSoundsLike = False
780           .MatchWildcards = False
790           .MatchFuzzy = True
800       End With

End Sub

ユーザーフォームのテキストボックス内で改行文字列を取り出す（その３）

先日の「ユーザーフォームのテキストボックス内で
改行文字列を取り出す（その２）」のつづきです。

http://wordvba.cocolog-nifty.com/blog/2009/10/post-7d52.html

前回、テキストボックス内の文字列中の
改行記号(vbCrLf)を★●★に置換してから
.iniファイルに保存する方法を紹介しました。

今回は、前回と逆の作業の紹介です。

①.iniファイルに保存された文字列中の「★●★」を
「改行記号(vbCrLf)」に置換

②置換された文字列をテキストボックスに表示

上記①と②を実行するマクロです。

▼プログラム
Sub GetTextData()
       
      'データ取得用プログラム

      Dim strWord() As String '★●★で区切られた文字列
      Dim i As Integer
      Dim myData As String　'.iniファイルから取得した文字列
      Dim myMessage As String　'テキストボックスに表示用文字列

10    On Error GoTo Errorhandler

      '.iniファイル（ファイル名.ini)から保存済みの文字列を取得
20    myData = System.PrivateProfileString("ファイル名.ini", _
               "textdata", 1)
               
      '取得した文字列が空の場合、vbNullStringとする
30    If Len(myData) = 0 Then
40        myMessage = vbNullString
50    Else
      '取得した文字列が空ではない場合、★●★を改行記号(vbCrLf)に置換する
          '①★●★にて、取得した文字列を分解
60        strWord() = Split(myData, "★●★")
         
          '②分解した文字列の間に改行（vbCrLf）を挿入
70        myMessage = strWord(0)
         
80        For i = 1 To UBound(strWord)
90            myMessage = myMessage & vbCrLf & strWord(i)
100       Next
         
110   End If

JN:

120   TextBox1.Value = myMessage
130   TextBox1.SetFocus

140      On Error GoTo 0
150      Exit Sub

Errorhandler:
         
          '取得した文字列に★●★がない場合
160       If Err = 9 Then
170           myMessage = myData
180           GoTo JN
190       Else
200           MsgBox "エラーが発生しました。終了します。"
210           End
220       End If
         
End Sub

▼プログラムの解説

１０行、１６０行～２２０行
エラー処理です。
想定しているエラーは、取得した文字列に★●★が
含まれない場合です。

以前、このプログラムを作ったときには、このエラー処理は
必要だと思ったのですが、今実行すると、その必要性が
よくわかりません。。。

ひとまず、書いておいて問題は無いと思うので、そのままに
しました。いい加減で失礼します。

１３０行　
テキストボックスにフォーカス（カーソル）を移動

次回は、このシリーズの最終回（その４）です。

今までのプログラムをユーザーフォームに書き込んで
一つのプログラムとして作動するものを紹介します。

ベクターにテンプレート公開

ようやく、Vector (ベクター)に登録が完了しました。

Vector（ベクター）とは、ソフト登録数国内最大規模の
オンラインソフトウェア流通サイトです。

充実したダウンロードライブラリがあり、パソコンの
無料・有料ソフトが掲載されています。

このベクターに、私のワードマクロを掲載させて
いただくことになりました。

こちらをご覧ください。

「特許翻訳まなびの会」の河崎さんにお会いしました。

以前から、このブログを紹介していただいている「特許翻訳まなびの会」の
管理者であり特許翻訳者である河崎有美さんに初めてお会いしました。

私が河崎さんをたずねていったとか、仕事の都合で会ったとか
そういう訳ではなく、特許翻訳とかマクロとかそういうものは全く
関係のないイベントで偶然お会いしたのです。

今日は、その偶然の出会いの紹介。

昨日、大阪で行われたセミナーコンテスト（通称：セミコン）
にオブザーバーとして参加してきました。

私のメルマガでは紹介してあったのですが、私は１１月７日に
開催される名古屋のセミナーコンテストに出場します。

その下見や勉強もかねて、名古屋のセミナーコンテストに参加する
仲間と大阪のセミナーコンテストを「体験」してきたわけです。

で、今回の大阪セミコンに河崎さんが出場されていたんですね。

偶然の出会いでした。

河崎さんが発表されたセミナーの内容は、特許翻訳に関するもの
ではありません。

「本当の笑顔の取りもどす方法」とのことで、オリジナリティ
あふれる体験・ノウハウや、リラックスした話し方に引き込まれました。

セミコンでは、その出場者のひととなりがすごく発表内容に
あらわれるので、その点で非常に楽しめます。

出場者の７名の方々の本気度合いもビリビリ感じて、胸が熱くなる
瞬間が何度もありました。

自分の発表はまだ内容が確定していませんが、この大阪セミコンの
学びをいかして、等身大の自分を表現できる話をしたいと思いました。

ところで。。。

特許用のワードマクロの話で盛り上がれる人はほとんどいないので、
私のマクロに興味を示していただいている河崎さんにお会いできて
うれしかったです。

河崎さんはきさくな方で、いろんなお話をさせていただきました。

懇親会に向かう道、また懇親会で、特にワードマクロの話ばかりさせて
いただきました。少しうっとおしく感じられたかも。。。

「思いがけない出会い」のおまけつきのセミコン視察となりました。

河崎さん、ありがとうございました。