☰

Word 2010 文書内のグラフィック/テキスト間の間隔を削除するマクロはありますか?

tag-icon • tag-icon microsoft-word vba macros microsoft-word-2010
Word 2010 文書内のグラフィック/テキスト間の間隔を削除するマクロはありますか?

私は、グラフィック アイテムのみを含む Word (バージョン 2010) ドキュメントを頻繁に作成します。グラフィックの横に「New!」などのテキスト (これは残しておきたい) が付くこともあります。ドキュメント内のこれらのグラフィック/テキスト付きのグラフィック アイテム間のすべてのスペース (すべての種類) を削除するマクロを作成したいと思います。これにより、すべてのアイテムが 1 行に収まるまで 1 つずつ整列し、次のグラフィックが次の行で自動的に開始されます (その後、スペースなしでグラフィックが 1 つずつ繰り返されます)。現在、矢印、削除、およびバックスペース キーを使用して手動でこれを行っていますが、非常に時間がかかります。マクロを実行する前と実行後のドキュメントの外観を示す「前/後」の GIF 画像をアップロードしました。

マクロ前（スクリーンショット）マクロ後（スクリーンショット）

余談ですが、グラフィック間に特定の数のスペースを追加したい場合、マクロを「調整」して簡単にこれを可能にする方法はありますか? もしある場合、これを実現するにはマクロにどのようなテキストを追加する必要がありますか?

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

答え1

Word に組み込まれている「検索と置換」ツールは、作業の 90% を自動的に実行します。「特殊」ドロップダウン ボタンがある「詳細 >>」オプションを使用すると、改ページ、段落記号、スペースなどを検索できます。

この「特別」ボタンを使用すると、段落、さまざまな空白文字、改行などを選択できます。

残りの 10% は、VBA 開発者タブのマクロ レコーダーを使用して実行できます。

録画を開始し、必要な画像だけが得られるまで、すべての改行、段落記号などを置き換えます。

次に録画を停止します。 マクロマジックの完成です。

簡単なテストで、さまざまな書式設定の種類のほとんどを消去する方法が次のように表示されます。^p「段落記号」に対応し、検索と置換ツールはそれを""何もないものに置き換えます。

Sub Macro1()
'
' Macro1 Macro
'
'
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^p"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "^t"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^b"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^m"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = " "
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub

各画像の間にスペースを入れたい場合は、.Replacement.Text = ""各部分を次のように変更してスペースを含めます。.Replacement.Text = " "

関連情報