みんなのワードマクロ

またかよ？というテーマですが、今までのものとはかなり違います。

まず、「ボタンが美しい！」ことと、「読者さんとの共同制作」という点が新しいです。

また、新しいコードも覚えましたので、是非ご覧ください。

「highlight.dot」をダウンロード

●作用

テキストファイルに書いたキーワードを現在の文書中から探して、蛍光色にします。

蛍光色として選べるのは、文字に重ねても文字が読みやすいと思われる黄色や明るい緑などを中心に6色を使えるようにしました。

よって、キーワードの種類別に着色することができます。

また、キーワードの蛍光色を削除する機能もあります。

以前紹介した翻訳文の比較表自動作成マクロとあわせて使うと、その効果が発揮されます。

どんな使い方があるのか、いろいろとお試しください。

次回以降、とっておきの使い方を紹介しますので、それもお楽しみに。

●使い方

１．テンプレートを登録します。こちらをご参照ください。

２．

このような７つのボタンがツールバーに表示されます。

左から６つが、それぞれのボタンの色に対応した蛍光色を着色するマクロで、一番右が蛍光色を削除するマクロです。

３．キーワードを記載したテキストファイルを用意します。

以下のファイルを適当なフォルダに保存してください。

参考ファイル：「sample_keyword1.txt」をダウンロード

「sample_keyword2.txt」をダウンロード

ここにあげたキーワードは英語ですが、日本語でもかまいませんし、日本語と英語が混在してもかまいません。

あまり意味のあるキーワードを載せていません。単なる例示と思ってください。

４．キーワード検索対象となるワード文書を用意します。

参考ファイル：アップル社の7,536,565特許「sample_patent_us7536565.doc」をダウンロード

これも、最近の特許から選んだだけで、あんまり意味があるものではありません。単なる例示と思ってください。

５．着色する色のボタンをクリックします。

上記の「キーワード検索対象となるワード文書」を開いてください。

７つのボタンともに同じ操作で使えます。好きな色のボタンをクリックしてください。

ボタンをクリックするとファイルを選択する窓（左図参照）が開きます。

この窓を開いた状態では、テキストファイルだけが表示されるようにしました。

上記ステップ３にてテキストファイルを保存したフォルダを選び、どちらか一つのファイルを開きます（ファイルを選択してダブルクリックまたは、開くボタンをクリック）。

６．着色されます。

●工夫

①キーワードをテキストファイルに書きました。

今回は、複数のキーワードリストを使い分けることができます。

今までは、マクロのテンプレートにキーワードを書く手法を使っていましたが、これだと複数のキーワードリストを使い分けるのが難しいと感じておりました。

②ファイル選択が簡単！

プログラムの２０，４０～７０行に記載されています。

キーワードのファイルを通常のファイルを開く窓から直感的にできます。

③ボタンの色が美しい！

自作するのをやめました。

「簡単プログラミングExcel VBA 応用編」の付録のFaceIDリストから気に入ったボタンを探し出して使いました。

美しいですねぇ。仕事中についついクリックしてしまいます。

④テキストファイルの読み込み機能を使いました。

初めて使いました。スピードが速い感じがします。

プログラムの９０，１３０，１４０，２６０行に関連のコードが書かれています。

ワードのVBの編集画面のヘルプファイルを見ると少し意味がわかると思います。

実際の作用としては、テキストファイルのファイル名を選んだ後、「シーケンシャル入力モード」でファイルを開いて、ファイルの先頭からファイルの末尾（EOF)までの文字列を一つずつ取得していることになります。

●プログラム（共通部分）

myHLCの文字列に、着色する色を代入して、以下の共通のプログラムを実行しています。

Sub 所定文字列を蛍光色にする(myHLC As String)

      Dim FileName
      Dim keyWord As String
      Dim actDoc As Document
      Dim myColorIndex As Long
      Dim myRange As Range
      Dim mydlgOpen As Dialog

      '対象文書の設定
10    Set actDoc = ActiveDocument

      'ダイアログボックスの設定
20    Set mydlgOpen = Dialogs(wdDialogFileOpen)

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

      'キーワードファイル（テキストファイルに限定）を指定する
40    mydlgOpen.Name = "*.txt"

50    If mydlgOpen.Display = -1 Then
60        FileName = mydlgOpen.Name
70    End If

80    If Len(FileName) <> 0 Then

          'テキストファイルをシーケンシャル入力モードで開く
90        Open FileName For Input As #1
         
          '対象文書を選択
100       actDoc.Activate
         
          '蛍光ペンの現在の設定を仮保存
110       myColorIndex = Options.DefaultHighlightColorIndex
         
          '指定した蛍光色に変更
120       Options.DefaultHighlightColorIndex = myHLC
         
          'テキストファイル内で、最終行まで繰り返す処理
130       Do While Not EOF(1)
         
140           Line Input #1, keyWord
               
150           With myRange.Find
160             .Forward = True
170             .Wrap = wdFindContinue
180             .MatchWholeWord = True
190             .MatchByte = True
200             .Format = True
210             .Replacement.Highlight = True
220             .Execute findText:=keyWord, _
                 ReplaceWith:=keyWord, Replace:=wdReplaceAll
230           End With
               
240       Loop
         
          '蛍光ペンの設定を元に戻す
250       Options.DefaultHighlightColorIndex = myColorIndex
         
260       Close #1
       
270   End If

280   Set actDoc = Nothing
290   Set mydlgOpen = Nothing
300   Set myRange = Nothing
       
End Sub

●補足

このマクロは、このブログの読者さんと共同でアイディアをぶつけながら作りました。

いただいた提案が面白かったので、自分なりに解釈したり、使える技術を探したりしながらの作業。

おかげさまで、仕事の新しい方法を知って効率化ができましたし、マクロのコードもたくさん覚えました。

ありがとうございました。

文書中のカタカナ文字を蛍光ペンで着色します。

３０行のとおり、現在の設定では、「明るい緑色＝wdBrightGreen」が設定されていますが、以下のように別の色も設定できます。

wdAuto

wdBlack

wdBlue

wdBrightGreen

wdByAuthor

wdDarkBlue

wdDarkRed

wdDarkYellow

wdGray25

wdGray50

wdGreen

wdNoHighlight

wdPink

wdRed

wdTeal

wdTurquoise

wdViolet

wdWhite

wdYellow

５０行の

.Text = "([ァ-ヾｦ-ﾟ]{1,})"

が、カタカナ１文字以上の設定方法です。

Rangeオブジェクトでの一括置換としていますが、ワイルドカードの設定をtrueにすることをお忘れなく（８０行）。

置換対象は、カタカナ文字であり、「検索したカタカナ文字列」を、蛍光ペンで着色した「検索したカタカナ文字列と同じ文字列」に置換するという命令です。

上記の「検索したカタカナ文字列と同じ文字列」は、１１０行のとおり「\1」として表示されます。

Sub カタカナ()

      Dim myRange As Range
      Dim myColorIndex As String

10    Set myRange = Selection.Range

      '蛍光ペンの設定を仮保存
20    myColorIndex = Options.DefaultHighlightColorIndex

      '蛍光色を変更
30    Options.DefaultHighlightColorIndex = wdBrightGreen

40    With myRange.Find
50      .Text = "([ァ-ヾｦ-ﾟ]{1,})"
60      .Forward = True
70      .Wrap = wdFindContinue
80      .MatchWildcards = True
90      .Format = True
100     .Replacement.Highlight = True
110     .Replacement.Text = "\1"
120     .Execute Replace:=wdReplaceAll
130   End With

      '蛍光ペンの設定を元に戻す
140   Options.DefaultHighlightColorIndex = myColorIndex

150   Set myRange = Nothing

End Sub

ようやく見つけました。

最近数ヶ月は、この本でマクロを勉強しています。

「Learning Word Programming」です。

2009/6/28現在では、アマゾンの中古で882円で売られていますね。

僕が4月に購入したときには3500円程度したのですが。。。

同じ著者の「Writing Word Macros」もいいと思います。中古市場では、「Learning Word Programming」に比べてかなり値段が高いですが（2009/6/28現在で3206円）。

この本は、「Learning Word Programming」の改訂版であり、ワード２０００までカバーしています。「Writing Word Macros」はワード９７対応です。

先日、著者のSteven Roman教授に本の感想（感謝）とともにいくつか質問をして確認したのですが、ワード2002以降のバージョンへの改訂版は出版の予定がないそうです。

残念ではありますが、selection オブジェクトやrangeオブジェクトの基礎を学ぶには、個人的には「Learning Word Programming」で十分事足りています。

「Rangeオブジェクトの範囲指定」の記事を書いたときにも、「Learning Word Programming」のＰ．２１５，２１６に書かれていることを参考にしています。

また、Ｐ７１には、変数の初期化の話が載っているのですが、「変数はすべてが自動で初期化されるけど、ミスをなくすためには明示的に自分で初期化をしたほうがいいよ」というアドバイスが載っています。

こういうことって、プログラミングを初歩的なところから習わないと出会えないようなアドバイスですよね。

プログラミング独習者にとっては、非常にありがたいことです。

この本に出会ったきっかけは、以前紹介したニュースグループです。

このページで「good book」のキーワードで検索するとこの本が紹介されています。

紹介される書籍は、どれも古いものばかりです。

絶版になっているものもあり、中古本をアメリカから取り寄せる必要があるものもあります。

他にも買った書籍があるので、また紹介します。

中間処理で審査官が提示した引例が、妥当なものであるかの判定ソフトを作成しております。

そのソフトでは、米国特許法第102条（b）でひかれた引例が、出願人の米国への特許出願日前1年より前に、公知となったものかどうかを判定します。

そのときの判断に使う基準日の算出のために書いてみました。

●工夫
入力する日付の書式を間違えると、再度入力画面（inputbox）が表示されるようにしました。

実際に入力できる書式はいろいろとありまして、今年の年月であれば「6/27」と入力するだけで、「2009/6/27」を意味するようになります。

また、「09/6/27」でも大丈夫です。

「98/6/27」であれば、「1998/6/27」と判断されます。

このあたりのルールは、ワード任せであり、パソコンの時計と連動しているように思います。

年末（たとえば、2008/12/20）に、「1/1」と入れると、2008/1/1ではなくて、2009/1/1に間違えられたりしたように記憶しています。

あいまいですみません。

●個別説明
40行から90行で、inputboxを使って日付を入力するコードが書かれています。

なぜ、わざわざvariant形式のデータ変数(varDate)を使って入力をさせて、その後、date形式のデータ変数(myfileD)に入力して変更した理由を説明します。

date形式のものにinputboxでデータを入力すると、キャンセルボタンを押したときにdate形式のデータ変数に""が入力されてしまいます。

つまり何もない状態です。

そうすると、date形式のデータ変数にあわない（想定していない文字列）であるために、その時点でエラーが発生してしまいます。

よって、キャンセルしたいのに、エラー発生（エラーコード１３）と判定されてしまうわけです。

エラーは、2005/5/5/5のように、日付が誤入力された場合にも同じエラーコード１３が発信されます。

よって、キャンセルボタンが押されたことを、日付のご入力から正確に区別するためには、inputboxで受ける変数のデータ形式がdateであると都合が悪いわけです。

そういう理由から、以下のような長いコードになったわけです。

これは経験則でやっているだけで、別の書き方もあるんじゃないかなと思っていますが、とりあえず今はこういう書き方にしています。

●質問（どなたかご存じの方、教えてください。）

2回続けて日付の入力書式を間違えると、エラーが表示されます（30行と40行の間にある「ErrReturn:」にコントロールが戻ってくれません）。

理由がわかる方、教えてください。

●プログラム
しかし、やたら長いですね。

もっと短くできるはず。しかし、私みたいに、短く書くすべを知らなくても、なんとかプログラムが機能してほしい結果が得られてしまうところがいいですね。

パソコンの能力が高いので、多少面倒な遠回りの処理をしても、体感速度は全く変わりませんからね。

Sub グレースピリオド()

      Dim varDate As Variant
      Dim myfileD As Date '本願US出願日
      Dim gracePDY As Integer '本願US出願1年前の年
      Dim gracePDM As Integer '本願US出願1年前の月
      Dim gracePDD As Integer '本願US出願1年前の日
      Dim gracePD As Date  '本願US出願1年前の日付
      Dim Message As String
      Dim Title As String

10    On Error GoTo グレースピリオド_Error

20    Title = "US引例の判定"
30    Message = "本願のUS出願日を入力してください。" & vbCr _
                   & "書式: 2009/6/27"

ErrReturn:

40    varDate = InputBox(Message, Title)

50    If varDate = "" Then
60        End
70    Else
80        myfileD = varDate
90    End If

100   gracePDY = Year(myfileD) - 1
110   gracePDM = Month(myfileD)
120   gracePDM = Day(myfileD)

130   gracePD = gracePDY & "/" & gracePDM & "/" & gracePDM

140   MSGBOX "グレースピリオドの基準日は" & gracePD & "です。"

150      On Error GoTo 0
160      Exit Sub

グレースピリオド_Error:

170       If Err = 13 Then
180           GoTo ErrReturn
190       Else
200           MSGBOX "エラーが発生しましたので終了します。"
210       End If

End Sub

英文作成時に役立つマクロの紹介です。「doublespace.dot」をダウンロード

●用途
このマクロが対象としているのは、英文中に間違って記載してしまった連続するスペース二つをスペース一つに書き換えるマクロです。

文章と文章の間のスペース（ピリオドの後のスペース）は対象外です。

昨日、英文中に誤って書かれている二つのスペースを一つのスペースに書き換える作業がありました。

ひとつひとつ探すのは非常に面倒ですよね。とくに書類のページ数が多い場合には目が疲れます。

職場では以下のワイルドカードを使って一つ一つ確認しながら作業をしました。

検索する文字列：([a-zA-A]{1,})__([a-zA-A]{1,})
置換後の文字列：\1_\2

注意！！　上の文字列中の”_”は半角のスペースを示します。

上記置換式は、1文字以上の大文字小文字のアルファベットで挟まれた半角スペース二つを半角スペース１つに置換するものです。

よって、ピリオド、記号、コンマの前後のスペースは置換対象外となっています。

今回紹介するマクロでは、上記の置換方法に基づいた「一括置換」と「個別置換」の二つの方法をとりあげます。

わざわざマクロにする必要もない感じもしますねぇ。。。

●使い方
①テンプレートをインストールします。こちらを参照。

②３つのボタンがツールバーに表示されます。

  一番左にある[DS一括]が、「ダブルスペースを一括置換するマクロ」に対応します。

真ん中の区切り線から右側の二つのボタンが「ダブルスペースを個別に置換するマクロ」に対応します。

「ダブルスペースを個別に置換するマクロ」は、二つのステップから成り立ちます。

真ん中にあるのが「ダブルスペースを選択するステップ」で、右端のボタンが「選択されているダブルスペースをシングルスペースに変更し、次のダブルスペースを選択するステップ」に対応します。

③対象となる文書を開き、ボタンをクリックします。

④置換されます。

●工夫
①「ダブルスペースを一括置換するマクロ」では、置換したダブルスペースの前後の単語を赤で着色しました。

よって、一括置換した場合でも、どのスペースを削除したのかわかります。

②「ダブルスペースを個別に置換するマクロ」では、誤作動がないように以下のような条件を加えました。

ダブルスペースが選択されている場合には、「選択されているダブルスペースをシングルスペースに変更し、次のダブルスペースを選択」します。（以下の「シングルスペースに置換」の10行目）

このプログラムの考え方は、以前紹介した「参照符号の削除」と同じです。

●プログラム
「ダブルスペースを個別に置換するマクロ」

Sub ダブルスペースを選択()

      Dim myRange As Range
      Dim SE As Long

10    SE = Selection.End
20    Set myRange = ActiveDocument.Range(SE, SE)

30    With myRange.Find
40        .Text = "([a-zA-A]{1,1})  ([a-zA-A]{1,1})"
50        .Wrap = wdFindContinue
60        .MatchWildcards = True
70        .Replacement.Font.Color = wdColorRed
80        .Execute
90    End With

100   If myRange.Find.Found = True Then
110       myRange.Start = myRange.Start + 1
120       myRange.End = myRange.End - 1
130       myRange.Select
140   Else
150       MsgBox "ダブルスペースが見つかりません。"
160   End If

170   Set myRange = Nothing

End Sub

Sub シングルスペースに置換()

10    If Selection = "  " Then
20        Selection = " "
30        Call ダブルスペースを選択
40    Else
50        MsgBox "選択範囲が不適切です。"
60    End If

End Sub