Word VBA マクロ スペースをインデントに変換する

例えば段落の先頭から(全角半角問わず)スペースが５つ連続して入力されていたら、スペース５つ全てを削除して5文字分のインデントに変換したいです。

変換前　□□□□□あいうえお　※□＝スペース
変換後　　　　　　あいうえお

Wordの文書全体がインデントではなくスペースが段落の先頭から連続で入力されていて困っています。
段落の先頭に入力されたスペース１つのみインデントに変換するマクロはありましたが、連続したスペースをインデントに変換するマクロは見つけられませんでした。

お詳しい方、ご教授よろしくお願いします。

No.4 ベストアンサー 回答者： enunokokoro 回答日時： 2021/06/28 22:28

どうやら、Wordの[オプション]にある[貼り付け時に自動調整する]が

関わっているようです。
https://docs.microsoft.com/ja-jp/office/vba/api/ …
この設定を一時的に無効にし、マクロ処理して再度有効に戻すことで
対応できそうです。

※　修正版

Sub 行頭スペースをインデントに()
'
' スペースが半角の場合0.5文字に変換
'
　Dim myRange As Range
　Dim par As Paragraph
' [貼り付け時に自動調整する]を一時的に無効にする
　Options.PasteSmartCutPaste = False

　Set myRange = ActiveDocument.Range(0, 0)
　With myRange.Find
　　.Text = "[　 ]{1,}"
　　.MatchWildcards = True

　Do While .Execute = True
　　Set par = myRange.Paragraphs.First
　　　If myRange.Start = par.Range.Start Then
　　　par.CharacterUnitFirstLineIndent = LenMbcs(myRange) / 2
　　　myRange.Delete
　　　End If
　Loop

　End With
　Set myRange = Nothing
' [貼り付け時に自動調整する]を有効に戻す
　Options.PasteSmartCutPaste = True
End Sub

Function LenMbcs(ByVal str As String)
　LenMbcs = LenB(StrConv(str, vbFromUnicode))
End Function

No.1のマクロでも、Options.PasteSmartCutPasteの処理をいれて、
応答なしにならないようにしてください。

関連情報
https://www.wordvbalab.com/code/6858/

No.3 回答者： enunokokoro 回答日時： 2021/06/28 22:05

No.1のマクロとNo.2のマクロでは、動作は一緒です。

「応答なし」になる条件があるみたいで、特定の半角記号が段落頭の
全角または半角スペースの後ろにある場合に、半角スペース1つ分に
置き換わり残るようです。
その結果、その段落に残ったスペースを対象に無限の処理をしようと
するようで、結果的に「応答なし」になるようです。
私の試してみた結果、半角の大括弧・丸括弧・引用符・二重引用符が
行頭スペースの直後にある場合に、半角スペース1つ分に置き換わり、
その部分で無限ルールしているようです。
[や(または"や'などを全角にすれば、私が提示したマクロでも問題は
ないのですが、それでは無意味なので対処方法がないか検討します。

対処方法が見つかるまで、しばらくお待ちください。

No.2 回答者： enunokokoro 回答日時： 2021/06/26 15:48

> 半角スペースの場合は0.5文字分のインデントに変換

通常は、文の開始位置を考えれば全角と半角は分けますよね。
この場合、ユーザー定義関数を用意すれば可能です。

par.CharacterUnitFirstLineIndent = Len(myRange)
LEN関数を使い、文字数を取得した分だけインデントしています。
このLEN関数では0.5文字単位では出せないので、以下で説明している
ユーザー定義関数のLenMbcs関数を用意して対応します。
https://docs.microsoft.com/ja-jp/office/vba/lang …

Function LenMbcs(ByVal str As String)
　LenMbcs = LenB(StrConv(str, vbFromUnicode))
End Function

Sub 行頭スペースをインデントに()
'
' スペースが半角の場合0.5文字に変換
'
　Dim myRange As Range
　Dim par As Paragraph

　Set myRange = ActiveDocument.Range(0, 0)
　With myRange.Find
　　.Text = "[　 ]{1,}"
　　.MatchWildcards = True

　Do While .Execute = True
　　Set par = myRange.Paragraphs.First
　　　If myRange.Start = par.Range.Start Then
　　　par.CharacterUnitFirstLineIndent = LenMbcs(myRange) / 2
　　　myRange.Delete
　　　End If
　Loop

　End With
　Set myRange = Nothing
End Sub

この回答へのお礼

重ねてご回答ありがとうございます！
大変恐縮ですが、ご回答いただいたマクロを動かすと、
途中で「応答なし」になり、どうやら半角スペースは一文字分のインデントに変換されているみたいです。
大変申し訳ありませんが、原因が分かりましたらご教授いただけないでしょうか。
よろしくお願いいたします。

お礼日時：2021/06/28 19:41

No.1 回答者： enunokokoro 回答日時： 2021/06/26 09:48

見つけたマクロとはこちら↓のことですか？

https://tonari-it.com/word-vba-indent-space/
このマクロを応用してもよいのですが、そのままだと使いにくいので
変更しています。
行頭のスペースは、全角半角どちらでも同じ一文字単位でインデント
します。

Sub 行頭スペースをインデントに()
　Dim myRange As Range
　Dim par As Paragraph

　Set myRange = ActiveDocument.Range(0, 0)
　With myRange.Find
　　.Text = "[　 ]{1,}"
　　.MatchWildcards = True

　Do While .Execute = True
　　Set par = myRange.Paragraphs.First
　　　If myRange.Start = par.Range.Start Then
　　　　par.CharacterUnitFirstLineIndent = Len(myRange)
　　　　myRange.Delete
　　　'　myRange.Collapse wdCollapseEnd '無くても問題ない
　　　End If
　Loop

　End With
　Set myRange = Nothing
End Sub

この回答へのお礼

ご教示いただき、本当にありがとうございます！
大変恐縮ですが、半角スペースの場合は0.5文字分のインデントに変換する、と設定することは可能でしょうか？

お礼日時：2021/06/26 13:30