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

Question

先日、同じ内容の質問をさせていただきましたが、分からないことがあり、再度質問させていただきました。
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文字分のインデントに変換できないでしょうか？

追伸　先日ご回答いただいた方には心より感謝いたします。再度のご質問になってしまい、本当に申し訳ないです。

enunokokoro · Accepted Answer

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

enunokokoro · Answer

やはり、私には難しくて条件を満たすものはできないかも。
ぶら下げインデントとスペースの数が一致した場合に、左インデント
だけにする処理が、どうしても不完全なままになってしまします。

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

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

enunokokoro · Answer

思っていたより難問でした。どう処理するかだけでなく、インデントと
スペースとの関係をマクロで書く処理方法も未だ不十分な段階です。
このままだと、最終回答から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

enunokokoro · Answer

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

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

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

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

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

enunokokoro · Answer

前回の回答者です。
インデントがずれるとは、どんな状況なのでしょうか？

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

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

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

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

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

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

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

前回の回答者です。

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング

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