みんなのワードマクロ

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

WordVBA — 2009-11-08T20:39:25+09:00

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

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

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

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

お試しください。

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

WordVBA — 2009-10-31T11:17:12+09:00

先週のコメントにて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

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

WordVBA — 2009-10-25T12:09:13+09:00

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

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

▼プログラムの解説

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

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

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

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

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

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

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

WordVBA — 2009-10-19T13:49:00+09:00

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

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

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

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

こちらをご覧ください。

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

WordVBA — 2009-10-18T14:56:15+09:00

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

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

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

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

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

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

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

偶然の出会いでした。

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

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

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

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

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

ところで。。。

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

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

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

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

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