【コード】文字書式を保存/復元するWordマクロ

2018年4月23日追記
【コード】文字書式を保存/復元するWordマクロ(その2)に改良版を掲載

太字、下付き、上付きなど、文字の書式が設定されている文章をテキストエディターで編集したいときありませんか?

通常、この文章をテキストエディタにコピーすると、書式がすべてなくなってしまいますね。
そんな悩みを解決するマクロです。

前回のこちらの記事 の応用版です。

用途

ウェブやワードの文章をテキストエディタで編集する場合に、必要最小限の文字書式を保持できます。

編集が終わった後、ワードにコピーしたテキスト情報にもとの文字書式を復元します。

作用

文字書式が含まれる文書を用意します。

書式のタグ化

①文字書式をhtmlで使われるタグに変換します。(プログラム1)

書式のタグ化

②タグを書式に戻します。(プログラム2)

書式のタグ化

保持できる文字書式

以下の6種類です。各プログラムの10行~60行に定義しました。
下付き
上付き
太字
斜体
下線(一重線)
取り消し線

工夫

プログラム1の22行~24行に、フィールドやリンクの設定を解除するコードを挿入しました。

ウェブから文章をコピーした場合に、なんらかの情報が文字に組み込まれていると、タグ化が正常に作動しない場合があります。

これを回避するために、文字に組み込まれた情報をまず削除してからタグ化をしています。

登録方法

以下のページをご覧ください。
○ ワードマクロの作成(ver.95~2003)
○ ワードマクロの作成(ver.2007)
○ マクロにショートカットを割り当てる

プログラム1 書式をテキスト情報(タグ)に変換


Sub 文字書式をタグ化()

 Dim myRange As Range
 Dim myChr(1 To 6) As String
 Dim i As Integer
 Dim aField As Field
 
 '下付き
 myChr(1) = "sub"
 '上付き
 myChr(2) = "sup"
 '太字
 myChr(3) = "b"
 '斜体
 myChr(4) = "i"
 '下線(一重線)
 myChr(5) = "u"
 '取り消し線
 myChr(6) = "s"
 
 'フィールドのリンク削除(太字の無限ループに入ることがあるから)
 For Each aField In ActiveDocument.Fields
  aField.Unlink
 Next aField
 
 '書式のタグ化
 For i = 1 To 6
  Set myRange = ActiveDocument.Range(0, 0)
  
  With myRange.Find
   .Wrap = wdFindStop
   If i = 1 Then
    .Font.Subscript = True
   ElseIf i = 2 Then
    .Font.Superscript = True
   ElseIf i = 3 Then
    .Font.Bold = True
   ElseIf i = 4 Then
    .Font.Italic = True
   ElseIf i = 5 Then
    .Font.Underline = wdUnderlineSingle
   ElseIf i = 6 Then
    .Font.StrikeThrough = True
   End If
   .Execute findText:=""
  End With
  
  Do While myRange.Find.Found = True
   With myRange
    If i = 1 Then
     .Font.Subscript = False
    ElseIf i = 2 Then
     .Font.Superscript = False
    ElseIf i = 3 Then
     .Font.Bold = False
    ElseIf i = 4 Then
     .Font.Italic = False
    ElseIf i = 5 Then
     .Font.Underline = wdUnderlineNone
    ElseIf i = 6 Then
     .Font.StrikeThrough = False
    End If
   End With
   
   With Selection.Range
    .SetRange Start:=myRange.End, End:=myRange.End
    .Text = "</" & myChr(i) & ">"
    .SetRange Start:=myRange.Start, End:=myRange.Start
    .Text = "<" & myChr(i) & ">"
   End With
   
   myRange.Collapse
   myRange.Find.Execute
  Loop
  
 Next
 
 Set myRange = Nothing

End Sub

プログラム2 テキスト情報(タグ)を書式に変換


Sub 文字書式の復元()

 Dim myRange As Range
 Dim myChr(1 To 6) As String
 Dim i As Integer
 
 '下付き
 myChr(1) = "sub"
 '上付き
 myChr(2) = "sup"
 '太字
 myChr(3) = "b"
 '斜体
 myChr(4) = "i"
 '下線(一重線)
 myChr(5) = "u"
 '取り消し線
 myChr(6) = "s"
 
 For i = 1 To 6
  Set myRange = ActiveDocument.Range(0, 0)
  
  With myRange.Find
   .Wrap = wdFindStop
   .MatchWildcards = True
   .Execute findText:="[<]" & myChr(i) & "[>]*[<][/]" & myChr(i) & "[>]"
  End With
  
  Do While myRange.Find.Found = True
   With myRange
    If i = 1 Then
     .Font.Subscript = True
    ElseIf i = 2 Then
     .Font.Superscript = True
    ElseIf i = 3 Then
     .Font.Bold = True
    ElseIf i = 4 Then
     .Font.Italic = True
    ElseIf i = 5 Then
     .Font.Underline = wdUnderlineSingle
    ElseIf i = 6 Then
     .Font.StrikeThrough = True
    End If
   End With
   
   With Selection.Range
    .SetRange Start:=myRange.End, End:=myRange.End - Len(myChr(i)) - 3
    .Delete
    .SetRange Start:=myRange.Start, End:=myRange.Start + Len(myChr(i)) + 2
    .Delete
   End With
   
   myRange.Collapse
   myRange.Find.Execute
  Loop
 
 Next
 
 Set myRange = Nothing

End Sub

いただいたコメント

1. このマクロは便利ですね
こんにちは。
タグを付けるマクロは、とても便利なのですよね。違う書き方もできますので、あげてみました。
http://ameblo.jp/saglasie/entry-10516628393.html参考まで。
水野@教育アーティスト 2010-04-24 15:29:18
2. Re:このマクロは便利ですね

水野@教育アーティストさん

こんにちは。
ブログ拝見いたしました。

蛍光ペンを使うのいいですね。

私も蛍光ペンを多用するので、是非この
アイディア使わせていただきます。

あと、タグを挿入するメソッドとして、

Selection.InsertBefore “<b>”
Selection.InsertAfter “</b>”

などが使われていました。

これ、いいですね。

プログラム文がすっきりして美しいですね。
私使ったことがなかったのですが、便利です。

3. 文字書式のタグ化の応用について質問
新田さん、こんにちは。
(´・ω・`)ノ゛質問があります。「文字書式をタグ化マクロ」を、Ifの分岐処理ではなく、Select Caseというので行えないものでしょうか。理由は、自分でタグ化したい書式(見出し1~3、本文)の定義を追加したいのですが、If分岐だと上限があるらしいのと、入れ子が多くて記述が複雑になるためです。調べたところでは、If分岐とSelect Caseというのは、同じ結果をもたらすようなのですが、変数iとどう組み合わせればよいのかわかりませんでした。Select Case
Case A = True
Case B Is< 未満
Case C Is> 以下
Case X,Y
Case X To Y
Case Else
End Select
のように、いろんな条件を組み合わせられるようです(自分では使いこなせないですが)。「文字書式をタグ化マクロ」の本来の用途は、Word文書を一時的に動作の軽いテキストエディタで編集するためや、Word2003などのバイナリデータを除去することにあると思いますが、マークアップするタグを増やせることによって、

・簡易的なHTML生成っぽくも使える(本文を一度に<p>マークアップできるだけでも、作業が楽になる)
・書式スタイルを利用しているケースでは、太字や下線などの個々の設定より、書式スタイルをタグ化・復元できたほうが便利

と思いました。

つづく…

おちょこちょい
4. つづき>文字書式のタグ化の応用について質問
つづき
(文字数制限のため)+..。゚+ ゜*。 。*°提案まとめ+..。゚+ ゜*。 。*°1.Select Caseで書式の定義追加のカスタマイズが簡単になるといい。
2.太字や斜線などの直接的な装飾のほかに、書式スタイル名での定義ができると、マクロの応用範囲がさらに広がる。
例:<h1>見出し1スタイル</h>, <h2>見出し2スタイル</h2>, <h3>見出し3スタイル</h3>, <p>本文または標準スタイル</p>
<p class=”org”>独自のスタイルとか</p> ←こういうのはコードが複雑になってしまう??3.マクロ実行時に、Word上ではなく、直接txt文書に書き出せるとコピペミスが防げる。ささいな質問。
文字列に複数の書式を設定している時、入れ子でマークアップするには処理が複雑になるのでしょうか?
<b><i>太字とイタリックを設定した文字列</b></i> ←この閉じタグをHTML式に</i></b>の順に入れ子すると復元できなるなる?
おちょこちょい
5. Re:つづき>文字書式のタグ化の応用について質問

>おちょこちょいさん

ご質問をありがとうございます。
html用の用途とは、なるほど。

あと、スタイルをタグ化というのは、Wordならではのアイディアですね。

毎度ありがとうございます。

最近、返信に追いついていなくてすみません(笑)。

相互参照に関してもまだでしたし、あと、脚注に関しても最終コードを公開してませんでした。

未だ時間をかけて検証する時間がとれず。。。

気が多いので、別のことをしてみたりですみません(笑)。

ひとまず、1点だけご連絡。

このプログラムは、細かく検証はできていませんが、特定の条件でうまく動作できないことがあります。

Webからとった情報だと、誤動作をすることがありました。

正常な動作をご希望でしたら、水野さんから教えてもらった以下のページのコードがおすすめです。

http://ameblo.jp/saglasie/entry-10516628393.html

実行確認があり、より丁寧なつくりになっています。

6. 恐縮です…

>新田順也☆ワードプログラマーさん

脚注かっこマクロは、すでに公開されているもので何ら不都合を感じておりませんので、改善版を公開するかどうかは新田さんの気分にお任せいたします。

お忙しい中、丁寧に返事をいただき、感謝と恐縮です。
どうか、新田さんの好奇心を最優先でお願いします。

ε=ε=ε=(。・ω・)_旦~~粗茶でも飲んでごゆるりと…

コメントを送信した後、私の使っているテキストエディタには、ほぼ一括で複数段落にマークアップする機能のついていることが判明して、ちょっと愕然としています。

Wordにしろどんなアプリにしろ、すべての機能を一通り操作してみるべきだと、いま反省しております…。(ハンドルネームは体を表す…)

ちなみに、初心者向けのマクロの勉強によさそうなサイト(PDF文書)を見つけました。
『Word VBA基本&活用テクニック』紹介
http://www.clayhouse.jp/pbooks/wordvba.htm

オブジェクトの取得方法が、jQueryみたいに簡単だと扱いやすいのですが…

おちょこちょい
7. Re:恐縮です…

>おちょこちょいさん

どうも、いつもコメントをありがとうございます。
励みになります。

はい、またしても次の記事は、おちょこちょいさんからの質問とは違うものを扱っています(笑)。

気の向くまま書いていきますので、よろしくおつきあいください。

あと、『Word VBA基本&活用テクニック』のご紹介をありがとうございました。

これは私も以前見つけてました。

が、仲間内に知らせただけで、ブログでは書いていない。。。

内容を読み込んでからレビューをしようと思って放ったらかしでした。

相変わらず、いいところを突いてきていただき、ありがとうございます。

そろそろレビュー書かなきゃ。

これ、かなり細かく説明が書かれていますね。

ヘルプの解説より読みやすく整理されていていいなと思いました。

8. こんばんは。
面白そうだったので新田さんの記事を参考にコードを書いてみました↓
(エラー処理や細かい検証はしていませんので、あくまでも簡易的なものとして)http://www.ka-net.org/office/of41.html装飾部分をスタイルシートに分離するのが手間でしたので、htmlについては考慮しませんでした(^^;
kinuasa
9. Re:こんばんは。

>kinuasaさん

おはようございます。

スタイルもさっそくタグ化いただき、どうもありがとうございます。

おちょこちょいさんのアイディアとkinuasaさんのコードのおかげで、また一つお役立ちツールが生まれました。

モジュール化する書き方や、繰り返し処理、条件分岐、メッセージのシステムモーダルの設定など、今まで試したことのない書き方がたくさんあり、非常に勉強になります。

また、タグをつける前に改行記号を削除する処理も、定型文として使わせていただきたく、ヒントの山です。

やり遂げたい処理を念頭において、他の方が書いたプログラムを読むと非常に勉強になります。

個別に処理をするプロシージャーの書き方も面白いなと思いました。

目から鱗が落ちまくっています。
どうもありがとうございます。

ひとつ、改良点と思われることがありました。

文字数の関係で、別コメントに記述します。
新田順也☆ワードプログラマー 2011-02-10 08:18:59

10. Re:Re:こんばんは。

(上のコメントの追記です)

改良点について。

ボールドやイタリックなど書式が重なっている場合に、うまく判定できないことがあるようです。

原因は、以下の記述だと思います。
r.Text = “<” & sTag & “>” & r.Text & “</” & sTag & “>”

ここで、テキストで変換しているので、重なっている書式が落ちる場合があります。

以下タグ化のコードの一部ですが、InsertBefore とInsertAfter を用いて改良してみました。

改行記号に書式が含まれている場合を除いて、処理をしています。

Do While .Execute
If InStr(r.Text, vbCr) Then
If vbCr <> r.Text Then
r.End = r.End – 1
r.InsertBefore “<” & sTag & “>”
r.InsertAfter “</” & sTag & “>”
Else
‘r自体が改行記号の場合→何もしない
End If
Else
r.InsertBefore “<” & sTag & “>”
r.InsertAfter “</” & sTag & “>”
End If

上記のようにしてみたらうまく処理できました。

スタイルまで保存できると、新しい用途が生まれそうですね。

どうもありがとうございます!!

11. Re:Re:Re:こんばんは。

>新田順也☆ワードプログラマーさん

こんにちは。

> ここで、テキストで変換しているので、重なっている書式が落ちる場合があります。
> 以下タグ化のコードの一部ですが、InsertBefore とInsertAfter を用いて改良してみました。

よく見たら水野麻子さんのブログでもそうなっていましたね(^^;
注意力不足、動作確認不足の表れです(^^;;;

トップへ戻る