More than 5 years have passed since last update.

[Word VBA] HTMLタグをできる限り消去するマクロ

Last updated at 2019-10-14Posted at 2019-07-13

#サンプルの取り方 Firefox編

Yahoo!Japanにアクセス。

右側がうざいうえに誰も政治を持ち込むなとは言わない件。なので「〇〇に政治を持ち込むな」というのは全部ネトウヨで確定ですわ。あと国民のものの国民は安倍晋三以外は指してないですね。韓国にしか威張り散らせない。さらにいうとこういうあほな広告って税金とかなので、そういった点でもIT業界（ただし働いている人たちを除く）がなんで儲けているのか、コンプライアンスや企業倫理って何ですかね。

2.気を取り直してF12を押します。
Yahooに限らずhead bodyときます。なのでBodyを開いたところで右クリックします。

3.Innter HTMLを選択します。

4.Wordで新規作成で新しいDocumentを開き貼りつけます。
これは新規作成を推奨します。これだけで56ページくらいいくのと、全部置換するので、前の部分も想定外の置換をされる可能性があるからです。

#コード
##今回は別に検索と置換に手で入力してもいいです
条件や数が多いですが、正規表現や特殊な参照設定は一切使用していないです。文字通りWordの検索と置換に入力してすべて置換するところを自動化しています
##マクロの自動記録で作ったんじゃないかって？
ええそうです、なのでオプション項目を削ろう、最初はそう思っていました。
https://tonari-it.com/word-vba-find-option/
これによると、Wordは前のオプション設定を引き継いでしまうそうです。
もちろんクリアは打っているんですが
Selection.Find.Replacement.ClearFormatting
しかしどこか1行だけ入っていません。いれたらおかしくなったからです。
なのでClearFormattingをかければいいというものではないため、オプションは全部明示した方がいいようです。リンク先の人はめっちゃ切れる人なのでsoredemo端折ってますが、自分はやらないです。

Sub WordDeleteHTMLTags()
'For Microsoft Word
'複数の条件でスクリプトとタグを置換によって消去し、タブを消去、2行以上続く改行を1行にします。
'必ず1度自分が削りたい部分だけが削られるか、確認してください。
'想定外の部分が削除される場合は検索文字列を変えるか、コメントにして無効化（コメントアウト）してください。
'ワイルドカード単体で完全に削除するよりは、ある程度削除して残った分を削るほうが安全です。
'<style type => </styrle>で囲まれるstylesheetを控除
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "\<[\!]--*--\>"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchFuzzy = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
'<style type => </styrle>で囲まれるstylesheetを控除
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "\<style?type*\>*\<\/style\>"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchFuzzy = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
'<if> </endf>で囲まれるスクリプトを削除
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "\<[\!]??\[if*\]\>*\<[\!]\[endif\]??\>"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchFuzzy = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
'<script> </script>で囲まれるjavascriptを控除
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "\<script*\>*\<\/script\>"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchFuzzy = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
' タグが ダブルクォーテーション不等号記号で終わるパターン。最初に英数字以外の1文字(半角スペースを想定）が入る

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "\<?[A-z0-9]{1,}*\""\>"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchFuzzy = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
' タグが ダブルクォーテーション+不等号記号で終わるパターン。
With Selection.Find
.Text = "\<[A-z0-9]{1,}*\""\>"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchFuzzy = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
' タグが 不等号記号で終わるパターン。
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "\<[A-z0-9]{1,}*\>"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchFuzzy = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll

With Selection.Find
.Text = "\<?[A-z0-9]{1,}*\>"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchFuzzy = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
' ////////////////// Clear Tab //////////////////
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "^t"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchFuzzy = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
' ////////////////// 2行以上続く改行を1行に //////////////////

With Selection.Find
.Text = "^13{2,}"
.Replacement.Text = "^13"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchFuzzy = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
With Selection.Find
.Text = "^13"
.Replacement.Text = "^p"
.Forward = False
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchFuzzy = False
.MatchWildcards = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
' ////////////////// 4以上連続する続くスペースを1に //////////////////

With Selection.Find
.Text = "^32{4,}"
.Replacement.Text = "^32"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchFuzzy = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
' 置換条件をクリア
Selection.Find.ClearFormatting
End Sub

#参考
##Wordの検索と置換ととRegExpの正規表現との違い
###WordにあってRegExpにない
行内に存在するイメージにマッチできる
書式も検索できる
?は任意の1文字を表し、[A-z]{0,1}という表現はできない。このため「特定の1文字があるかないか」という検索ができない。
これができたら上のコードはもっと短かった。
なお直前の文字の繰り返しは@を使用する。
メタ文字がほとんどない（スペースなどはある）例えば円記号+dで数字を表すことができるが、Wordではできない
任意の単語境界がない。

###RegExp
Wordほど日本語と英語のオプションが明示されておらずわかりづらい。
単にマクロを起動させるだけではなく、参照設定か RegexpをCreateObjectしなければコードが動かない。
しかも参照設定はRegExpから正式名が思いつかない Microsoft VBScript Regular Expression Version 5.5 なのでマニュアルなどを見ないとわからない。
Wordの場合、Selectionを文字単位で移動させるなどのテクニックが必要で、正規表現を理解してもWord独自の選択範囲の移動が難しい。
文字には強いがオブジェクトはRegExp自身では選択できない。
書式をまとめて検索できない。

##VBAではなく普通に検索と置換を呼び出す方法
Word のヘルプとトレーニング文章入力と編集文字列を検索および置換する
動画あり。現在のWordの検索と置換はショートカットキーを使う方が早い。
検索 Ctrl+F 置換 Ctrl+H
なおFとHは大文字だがShiftキーを押す必要はない。これはキーに大文字で表示してあるため、こういう表記になっている。

Word や Excel の "置換" 機能で簡単に変換したい
Word 2013までが対象
ワード2013基本講座：特殊文字の検索や置換
画面デザインが違うので、バージョンが同じものを見た方がよい。
Word 2016：高度な検索と置換を行うには - wanichan.com
セルフQ&A : Wordの検索と置換でワイルドカードを使用する基本を教えて下さい。answers.microsoft.com
【Word】ワイルドカードを使う場合の注意点（その1）
Word ：ワイルドカードを使った検索と置換を極める - 教えて！HELPDESK
ワイルドカード例題シリーズ - office-qa.com
Wordで文書内の文字を置換する方法 - dekiru.net
置換したら保存しましょうということまで書いているのがDekiru.net 並び替えについても説明がある。
ワイルドカード「*」「?」を検索 relief
Excelではチルダでエスケープする。このようにVBAで正規表現を使用せず各アプリケーションの検索と置換を使用すると、操作性がOffice間でも異なる。

連続する2つ以上のタブを1つにまとめる−置換 relief
タブの置換の使用例

##VBA編
段落内改行を一括置換するOutlookマクロ
Outlookではメール本文をWordで編集できる。このWordの機能を使った例。

Word VBAで文字列を置換する方法！いくつかの基本パターンを徹底解説

改行の置換はこの記事【Word】ネットからのコピペで混ざる「おかしな段落記号」を削除する
 WdFindWrap 列挙 (Word)
検索対象の選択範囲または指定範囲内に検索文字列が見つからなかった場合の、折り返し動作を指定します。
Const wdFindContinue = 1
検索範囲の先頭または末尾まで検索し、さらに検索を続けます。
WdFindMatch 列挙 (Word)
この列挙は廃止される可能性があるので使用しないでください。
廃止は2019あたりでもされていないので、オブジェクトブラウザで検索できる。
しかし、現在はすべてサポートされていない定数。しかも使用例も検索できなかった。
しかし、これらの定数は名前からして特殊文字にあたる。
http://computer-programming-forum.com/1-vba/f13380f46209dc5f.htm
Word 97で見つけた定数なんだけど使えるかな、というJefがこういうコードをあげて質問している。

Sub FindWhiteSpace()
'Object model reports wdMatchWhiteSpace = Const 65655 = &H10077
'On the Find & Replace dialog, this is represented by ^w
'For comparison, wdMatchParagraphMark = 65551 = ^p

    With Selection.Find
        .ClearFormatting
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False

        .text = ChrW(wdMatchWhiteSpace)  
        .Replacement.text = ""
        .Forward = True
        .Execute
    End With

End Sub

The Find object doesn't use these constants. However, you can use the
character combinations that are shown in the Find dialog.
Thus, for finding white text you would have
'.text = "^w"'
The complete set of the special characters you can use is available if you
take a look at the help entry for the Execute method of the Find object.

Findはこれを使用しないけど、使うことはできる。しかしやはり^wという表現が推奨されている。

Word.WdReplace
検索および置換を使用したときに置き換える個数を指定します。
Const wdReplaceAll = 2

#htmlタグの削除って結構難しい
どういう言語でも専用ソフト（アプリ）を使わないとうまく削除できないようです。
しかもWordでってないかな。なので調べてみました。

You get articles that match your needs
You can efficiently read back useful information
You can use dark theme

What you can do with signing up