先日の文書中のテキストボックス内の文字列を別紙に書出すマクロ に引き続いて、テキストの抽出用マクロです。
記事をご覧になった読者の方から、質問がありまして作ってみました。
このマクロでできること
Word文書中の本文中の蛍光ペンで着色された文字列をテキスト（書式無し）として別紙に書出します。
抽出したテキスト毎に改行をして列挙します。
マクロの解説
23行目
特定の文書で検索をした場合、文書最後の蛍光ペンを検出した後、次の蛍光ペンの検出判定が空の文字列に対して起こることがありました。
その場合、無限ループに入ってしまうので、蛍光ペンが見つかった場合には、文字列が少なくとも含まれているかどうかを判定しています。
25行目、26行目
改行記号（vbCR）も蛍光ペンで着色しうるのですが、改行記号の蛍光ペンが検出された場合には無視することにしました。
今回のマクロではあくまでもテキスト情報を取り出すことが目的ですので、改行記号が書出されると読みづらくなりますのでこのような処理としました。
実は、改ページ記号にも蛍光ペンで着色できますので、同様の処理を改ページ記号にしてもいいかもしれません。
30行目、39行目
テキストを書出した後に改行をしています。
ここに、文字列を入れる場合には、代わりに以下のメソッドを追記してもします。
.InsertAfter “追記する文字列”
コンマやタブで区切ることができますね。
マクロ
Sub 蛍光ペンのテキスト抽出() Dim myRange As Range 'Rangeオブジェクト Dim myText As String '抽出する文字列 Dim newDoc As Document '新規で開いた文書 '画面の更新をオフ Application.ScreenUpdating = False Set myRange = ActiveDocument.Range(0, 0) Set newDoc = Documents.Add With myRange.Find .Text = "" .Forward = True .Wrap = wdFindStop .Highlight = True End With '文書の最後の蛍光ペン後は、蛍光ペンが 'なくても検索されたと判定されることがあるため回避する処理 Do While myRange.Find.Execute = True And _ myRange.Text <> "" If InStr(myRange.Text, vbCr) Then If myRange.Text <> vbCr Then myRange.End = myRange.End - 1 With newDoc.Range .InsertAfter myRange.Text .InsertParagraphAfter myRange.Collapse direction:=wdCollapseEnd End With Else '蛍光ペンが改行記号の場合は無視 End If Else With newDoc.Range .InsertAfter myRange.Text .InsertParagraphAfter myRange.Collapse direction:=wdCollapseEnd End With End If Loop Set newDoc = Nothing Set myRange = Nothing '画面の更新をオン Application.ScreenUpdating = True End Sub
コメント
すみません。
蛍光ペンで無く二重下線の文字を抽出するには、どのようにすれば良いでしょうか？
お手数をおかけしますが、お教えください。
坂林さま
返信が遅くなりすみませんでした。
実は、この処理はWordでもできるので以下の記事をご覧ください。
まず、［検索と置換］ダイアログボックスで二重下線を探すように設定します。
【Word】［検索と置換］ダイアログボックスで書式を設定するショートカットキー
https://www.wordvbalab.com/word/4340/
次に、二重下線箇所を一気に選択してコピペします。
【Word】［検索と置換］ダイアログボックスにて複数箇所の文字列を選択する
https://www.wordvbalab.com/word/612/
どうぞお試しください！
紹介いただいたテクニックを使わせていただきます。
ありがとうございました。
初めて質問させていただきます。蛍光ペンで抽出するマクロ、重宝しています。論文執筆中で、同じテーマの論文を集めた一つの文書を作って、そこからmethodの表現だけ抜き出すという使い方をしています。論文のタイトルを見出しとしています。それでどの論文からの表現かという情報が欲しいのですが、蛍光ペンで抽出する際その見出しも一緒に抽出するようにすることは出来ませんか。よろしくお願いします。
木村さま
ご質問をありがとうございます。タイトルに特定の見出しスタイルを使われているという意味でしょうか。それでしたら、蛍光ペンの箇所から文書の先頭方向に向かって最初に見つけた特定の見出しスタイルの文字列を論文のタイトルとして取得できそうですね。
最近はたくさんご要望をいただいていて着手できませんが、今後同じような要望が多いようでしたら作ってみます。ひとまず仕様をもう少し細かく教えてください。
Beijing,China – Aug 10, 2020の文字列を、2020年8月10日 北京(中国)に変換する機能を作りたいと考えております。Beijingを北京、Augを8月、などは置換で出来ると思っているのですが、文字列の順番自体を入れ替えることはマクロの技術で可能でしょうか？
返信いただければ幸いです。
武藤さん
コメントをありがとうございます。
> 文字列の順番自体を入れ替えることはマクロの技術で可能でしょうか？
予測ができるような場合には可能です。どのような場合を想定しているのかわかればルール化をしてマクロにできます。
早速のご返信ありがとうございます。
具体的には、Beijing,China – Aug 10, 2020を2020年8月10日 北京(中国)
Tokyo, Japan – July 20, 2019 を2019年7月20日 東京(日本)、など英語表記を日本語に変換しさらにそれを日本式の順番に並べ替えるものを考えています。パターンは全て同じす。この場合にルール化をする際、どのようなコードが必要か、おおまかに教えていただくことは可能でしょうか？
武藤さん
おそらく翻訳で使われるものと理解します。通常、どのような翻訳手法の中で使うのか、どのタイミングで使うのかなどを考慮してプログラムを組みます。もしこの部分だけの翻訳ならば対象部分を検索してその見つかった個所だけ翻訳（置換）をして文字列の並べ替えをするというやり方になると思います。日本と中国以外のパターンがあるときにその翻訳用の用語集を組み込む必要もあります。
私がこのようなことを翻訳でするのであれば、上書き翻訳やGreenTとの組み合わせを考えます。なので、文字列の並べ替えだけのプログラムを組むと思います。今回は文字列の並べ替えという興味深い（他の人にも役に立つ汎用性のあるテーマと言う意味で）をいただいたので、並べ替え方法に回答をいたします。
いただいたメールアドレスにワイルドカードを用いた置換例をお送りいたしましたので、そちらをご覧になってお返事ください。
ご回答ありがとうございます。ご教示いただいた置換ルールとコードをもとに改良を加えたとろ、大枠のプログラムを組むことが出来ました。また、地名の翻訳に関しては別途ツールが必要ということも理解いたしました。この度は迅速かつご丁寧な対応本当にありがとうございました。
武藤さん
以下の記事にまとめましたのでご覧ください。
https://www.wordvbalab.com/word/13541/
「蛍光ペンのテキスト抽出」使わせていただきました。どうもありがとうございました。
文書を読み込むことが多いため、重宝しそうです。これからいろいろ使ってみます。
BUNMEI MOTOYAMA さん、コメントをどうもありがとうございます！
お役に立ててうれしいです。
テキストボックス内のハイライトは抽出できないのでしょうか？
Roboterさん、このマクロでは文書の「メイン文書」とよばれる本文の入力領域のみを対象にしているので、テキストボックス、ヘッダー、フッター、脚注、オートシェイプなどは対象にしていません。これらを対象にする場合には別の記述が必要です。