(再投稿) Word VBA マクロ スペースをインデントに変換する

先日、同じ内容の質問をさせていただきましたが、分からないことがあり、再度質問させていただきました。
https://oshiete.goo.ne.jp/qa/12429200.html

ご回答いただいたコードで動かしたところ、段落によっては上手くインデントに変換されたりインデントがズレたりします。

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

体裁を崩すことなく、各段落の先頭に入力された複数のスペースを、全角スペースは1文字分、半角スペースは0.5文字分のインデントに変換できないでしょうか？

追伸　先日ご回答いただいた方には心より感謝いたします。再度のご質問になってしまい、本当に申し訳ないです。

質問者からの補足コメント

• >ぶら下げインデントが設定された段落の場合なら体裁は崩れます。
  
  ご回答ありがとうございます。
  インデントがズレる段落は、仰る通りぶら下げインデントが設定された段落の場合だと思います。
  大変恐縮ですが、ぶら下げインデントが設定された段落の体裁を崩すことなく、行頭のスペースをインデントに変更することは可能でしょうか？

  No.1の回答に寄せられた補足コメントです。 補足日時：2021/07/19 21:13

No.5 ベストアンサー 回答者： enunokokoro 回答日時： 2021/07/29 08:48

No.4の回答は、迷い道に入っていたので勘違い部分がありました。

たぶん、以下の修正をした最終版で実行してみてください。
インデントが字数で指定された段落なら処理できているはずです。

Sub 行頭スペースをインデントに()
'
' たぶん、これが最終版になると思う
' スペースが半角の場合0.5文字に変換
'
　Dim myRange As Range
　Dim par As Paragraph
　Dim i, j, k As Single
' [貼り付け時に自動調整する]を一時的に無効にする
　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
　　　i = par.CharacterUnitFirstLineIndent
　　　j = LenMbcs(myRange)
　　　k = par.CharacterUnitLeftIndent

　　　If i < 0 Then
　　　Select Case j
　　　　Case Is = -i
　　　　　par.CharacterUnitFirstLineIndent = 0
　　　　　par.FirstLineIndent = 0
　　　　　par.LeftIndent = 0
　　　　　par.CharacterUnitLeftIndent = k + j
　　　　Case Is > -i
　　　　　par.CharacterUnitLeftIndent = k - i
　　　　　par.CharacterUnitFirstLineIndent = i + j
　　　　Case Is < -i
　　　　　par.CharacterUnitLeftIndent = k + j
　　　　　par.CharacterUnitFirstLineIndent = i + j
　　　End Select
　　　　Else
　　　　　par.CharacterUnitFirstLineIndent = j
　　　End If
　　　　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)) / 2
End Function

この回答へのお礼

お礼が遅くなりまして申し訳ありません。
ご回答ありがとうございました！
思ったとおりのインデントになりました！
本当にありがとうございました！

お礼日時：2021/08/04 00:16

No.4 回答者： enunokokoro 回答日時： 2021/07/28 22:06

やはり、私には難しくて条件を満たすものはできないかも。

ぶら下げインデントとスペースの数が一致した場合に、左インデント
だけにする処理が、どうしても不完全なままになってしまします。

とりあえず、一致した場合は処理をしないことで対応する一部修正版
として、締め切り前に追加投稿しておきます。

Sub 行頭スペースをインデントに()
'
' スペースが半角の場合0.5文字に変換
'
　Dim myRange As Range
　Dim par As Paragraph
　Dim i, j, k As Single
' [貼り付け時に自動調整する]を一時的に無効にする
　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
　　　i = par.CharacterUnitFirstLineIndent
　　　j = LenMbcs(myRange)
　　　k = par.CharacterUnitLeftIndent

　　　If i < 0 Then
　　　Select Case j
　　　　Case Is = -i
' ぶら下げインデントとスペースが一致した場合に処理しない
　　　　　GoTo L1
　　　　Case Is > -i
　　　　　par.CharacterUnitLeftIndent = k - i
　　　　　par.CharacterUnitFirstLineIndent = i + j
　　　　Case Is < -i
　　　　　par.CharacterUnitLeftIndent = k + j
　　　　　par.CharacterUnitFirstLineIndent = i + j
　　　End Select
　　　　Else
　　　　　par.CharacterUnitFirstLineIndent = j
　　　End If
　　　　myRange.Delete
L1:
　　End If
　Loop

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

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

No.3 回答者： enunokokoro 回答日時： 2021/07/23 19:39

思っていたより難問でした。

どう処理するかだけでなく、インデントと
スペースとの関係をマクロで書く処理方法も未だ不十分な段階です。
このままだと、最終回答から1週間で締め切り状態になってしまうので、
途中経過として、回答を追加しておきます。（一部修正済み）

Sub 行頭スペースをインデントに()
'
' スペースが半角の場合0.5文字に変換
'
Dim myRange As Range
Dim par As Paragraph
Dim i As Single
' [貼り付け時に自動調整する]を一時的に無効にする
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
i = par.CharacterUnitFirstLineIndent
If i < 0 Then
'
' この部分をどう処理するか検討中。幾つか案はあるが不十分
' この状態だとぶら下げインデントのスペースのみ削除する
'
Else
par.CharacterUnitFirstLineIndent = LenMbcs(myRange)
End If
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)) / 2
End Function

この回答へのお礼

ご検討いただき、誠にありがとうございます！
心より感謝いたします。
とても複雑な処理が必要なのですね。
私はマクロやインデントの知識があまりないので、とても勉強になります！

お礼日時：2021/07/25 10:17

No.2 回答者： enunokokoro 回答日時： 2021/07/20 08:33

う～ん、やはり[ぶら下げインデント]ですか。

前回質問への回答は、テキストファイルなどを読み込んでスペース分
だけを字下げインデントにすることを前提にしているので、Wordの
文書にあるスタイルやインデント処理された段落などは対象にしない
ことで処理ができるものです。
体裁の崩れがぶら下げインデントが原因だと、処理が複雑になります。

私はWordのマクロを勉強中で、簡単なものだけなら回答できますが、
複雑だったり長くなったりすると、何をしているのか分からなくなり
混乱することがあります。

関連する過去ログを読んでもらうと分かりますが、[左インデント]と
関係もあり、複雑な処理をする必要があります。
https://oshiete.goo.ne.jp/qa/8813481.html
この回答から今に至るまで、インデント関連は後回しにしていたので
未だにスキルアップしていません。今回を機会に再チャレンジをして
理解を深めようとは思います。

段落行頭のスペース数がぶら下げインデントの位置と同じか多い場合、
それぞれの処理をすることになるので複雑になります。
Do～Loopの処理を書き換えたり、字下げの値の処理を複数に分けたり
する必要があるので、マクロを提示するのに数日かかると思います。

No.1 回答者： enunokokoro 回答日時： 2021/07/19 18:48

前回の回答者です。

インデントがずれるとは、どんな状況なのでしょうか？

提示したマクロは、字下げインデントを設定するものです。
ぶら下げインデントが設定された段落の場合なら体裁は崩れます。
左インデントだけ設定された見出しなら、単純に字下げしてくれる
ように設定したつもりです。（文字サイズに応じた文字数で字下げ）
それぞれの段落にて、[段落]ダイアログを開いて確認すれば、指定の
字下げになっていると思います。

私が気が付かない字下げの動作があるのかな？