（Word2003 VBA） サブ文書作成後のアウトラインレベル値の取得処理で実行時エラー

Question

Word2003のVBAを使用して、開いている文書ファイルのアウトラインレベルが設定されている段落をサブ文書化するプログラムを作成しています。
その際、AddFromRangeメソッドを使用して特定の段落をサブ文書化することは出来るのですが、サブ文書作成処理の後で ある段落のアウトラインレベルの値を取得しようとすると、下記のエラーが発生します。

エラーメッセージ

『実行時エラー '4605'
アウトラインモードのためメソッドまたはプロパティが使用できません...』


上記エラーを回避し、無事にアウトラインレベル値を取得する為には何をすれば良いか、ご教授頂けたら幸いです。

なお、デバッグの為にステップ実行すると、上記のエラーは出ません。

参考までに、エラーが発生するサンプルコードを添付します。

-------------------------
Sub 選択範囲をサブ文書化()


Dim lngSPos As Long
Dim lngEPos As Long

Dim intOutlineLevel As Integer


'選択範囲のスタート／エンドポジションを取得
lngSPos = Selection.Start
lngEPos = Selection.End

'サブ文書化
ActiveDocument.Subdocuments.AddFromRange Range:=ActiveDocument.Range(lngSPos, lngEPos)

'パラグラフのアウトラインレベルを取得
intOutlineLevel = ActiveDocument.Range.Paragraphs.OutlineLevel ' ← ここでエラーが発生する

MsgBox "intOutlineLevel = " & intOutlineLevel


End Sub


---------------------------
サンプルコードについての補足

    下記のような内容・設定が行われている文書ファイルで
    この2行を範囲選択して、上記のサンプルコードを実行してみてください。

    1.目的 ← この行は、アウトライン番号が設定されている。
    本書は＊＊＊である。 ← この行は、本文として設定されている。

Answer 1

Word97,2000でテストしたらActiveWindow.View.Type = wdPageViewをOutlineLevel取得前に設定してやるだけで出来たんですが、2007ではエラーでました。
(2003は手元にないのでテストしてません)

で、あまりスマートではない回避方法ですが。
サブ文書化とアウトラインレベル取得のコードの間でVBAマクロを「Sub 選択範囲をサブ文書化_1()」「Sub 選択範囲をサブ文書化_2()」のように分割します。
そして"選択範囲をサブ文書化_1"の最後に、Application.OnTimeで"選択範囲をサブ文書化_2"を0秒後呼び出しします。

ようはサブ文書化した後にWord自身の処理をさせるためにマクロを中断させてます。
#DoeventsやAPIのSleepでは回避できません。

Answer 2

gekka様

お忙しい中、検証して頂きありがとうございます。
大変感激しております。


さて、ご提示頂いたApplication.OnTimeですが、当方の環境（Word　2003）でうまく動作しました。
（Doevents、Sleepによる　処理待ちの手法、及びActiveWindow.View.Type による画面表示モードの変更の手法
についてもためさせて頂きましたが、当方の環境でもうまくいきませんでした。）

実は、当方が質問時に貼り付けさせて頂いたサンプルコードは、エラー現象を簡潔に示す為に作成した簡易コードです。

実際にやろうとしていることは（コードを下方に貼付ますが）、ループ処理を用いて
『サブ文書作成～アウトライン番号取得』の処理を繰り返して実行したいのです。
このコードにご教授頂いた手法を取り入れようと四苦八苦してみましたが、うまくいきませんでした。


お忙しい所大変恐縮ですが、以下のコードを見て少しでもヒントとなるご意見を頂戴できたら幸いです。

（レベル1のアウトライン番号を持つ章をサブ文書化するプログラム）
---------------------------------------------
Sub アウトライン番号の章単位でサブ文書作成()

    Dim EachParagraph As Paragraph
    Dim strText As String
    Dim intOutlineLevel As Integer
    Dim lngCnt As Long
    lngCnt = 0
    Dim staPos As Long
    Dim endPos As Long
    Dim fndFlg As Boolean

    Const level = 1        '（見出し1のみ）

    'フラグ初期化
    fndFlg = False

    '文書情報の取得とサブ文書の作成
    For Each EachParagraph In ActiveDocument.Paragraphs
   
        'パラグラフのテキストを取得
        strText = EachParagraph.Range.Text
       
        'パラグラフのアウトラインレベルを取得
        intOutlineLevel = EachParagraph.Range.Paragraphs.OutlineLevel '①エラー発生箇所　（②の処理の実行後、ここの処理でエラー）
       
        'パラグラフ数カウンタをUp
        lngCnt = lngCnt + 1
       
        'サブ文書の作成
       
            If fndFlg = False Then
               
                If intOutlineLevel = level Then
               
                    fndFlg = True
                    staPos = EachParagraph.Range.Start
               
                End If
               
            Else
           
                If intOutlineLevel <= level Then
               
                    endPos = EachParagraph.Range.Start
                   
                    If endPos = 0 Then
                        endPos = EachParagraph.Range.End
                    End If
                   
                    'サブ文書化
                    ActiveDocument.Subdocuments.AddFromRange Range:=ActiveDocument.Range(staPos, endPos) '②
                   
                    'スタートポジションの設定とフラグのクリア
                    staPos = EachParagraph.Range.Start
                    fndFlg = True
                   
                End If
               
            End If
   
    Next EachParagraph

    '最後の章の対応
   
        'パラグラフ数の取得
        Dim lngParagraphCnt As Long
        lngParagraphCnt = ActiveDocument.Paragraphs.count
       
        '最終パラグラフのエンドポジションを取得
        endPos = ActiveDocument.Paragraphs.Item(lngParagraphCnt).Range.End

        '最終章をサブ文書化
        ActiveDocument.Subdocuments.AddFromRange Range:=ActiveDocument.Range(staPos, endPos)

    MsgBox "サブ文書作成処理完了"

End Sub

Answer 3

ループ処理するならこんな
ループの中身までは検証してないのでエラー吐きますが、やり方はわかると思います。

Option Explicit

Private Type LoopValue
    StartPos As Long
    EndPos As Long
    
    strText As String
    intOutlineLevel As Integer
    lngCnt As Long
    fndFlg As Boolean
    
    paragraphIndex As Integer 'ループのインデックス
    targetDocument As Document '対象となるドキュメント
End Type

'マクロ開始
Public Sub CreateOutlineSubDocuments()
    Call LoopMethod2(True)
End Sub

'OnTimeを受けるだけ
Public Sub LoopMethod1()
    Call LoopMethod2(False)
End Sub
Private Sub LoopMethod2(ByVal isStart As Boolean)
    Static value As LoopValue
    Const LEVEL As Integer = 1 '（見出し1のみ）
    
    If (isStart) Then
    '初期化のみ実行するブロック
        value.strText = ""
        value.intOutlineLevel = 0
        value.lngCnt = 0
        value.fndFlg = False
        value.paragraphIndex = 0
        Set value.targetDocument = ActiveDocument
        value.targetDocument.ActiveWindow.View = wdPageView
    End If

    If (value.paragraphIndex <= value.targetDocument.Paragraphs.Count) Then
    'このIfブロックがループの中身
        Dim eachParagraph As Paragraph
        Set eachParagraph = value.targetDocument.Paragraphs(value.paragraphIndex)

        value.strText = eachParagraph.Range.Text
        value.intOutlineLevel = eachParagraph.Range.Paragraphs.OutlineLevel
        value.lngCnt = value.lngCnt + 1

        'サブ文書の作成
        If value.fndFlg = False Then
            If value.intOutlineLevel = LEVEL Then
                value.fndFlg = True
                value.StartPos = eachParagraph.Range.Start
            End If
        Else
            If value.intOutlineLevel <= LEVEL Then
                value.EndPos = eachParagraph.Range.Start
                If value.EndPos = 0 Then
                    value.EndPos = eachParagraph.Range.End
                End If

                'サブ文書化
                Call value.targetDocument.Subdocuments.AddFromRange _
                (Range:=value.targetDocument.Range(value.StartPos, value.EndPos))

                'スタートポジションの設定とフラグのクリア
                value.StartPos = eachParagraph.Range.Start
                value.fndFlg = True
            End If
        End If

        'ここの処理でループの先頭に戻る
        value.paragraphIndex = value.paragraphIndex + 1
        Application.OnTime Now + TimeValue("00:00:00"), "LoopMethod1" 
        Exit Sub
    End If
        
    '最後の章の対応
    'パラグラフ数の取得
    Dim lngParagraphCnt As Long
    lngParagraphCnt = value.targetDocument.Paragraphs.Count

    '最終パラグラフのエンドポジションを取得
    value.EndPos = value.targetDocument.Paragraphs.Item(lngParagraphCnt).Range.End

    '最終章をサブ文書化
    Call value.targetDocument.Subdocuments.AddFromRange _
    (Range:=value.targetDocument.Range(value.StartPos, value.EndPos))

    MsgBox ("サブ文書作成処理完了")
    
    Set value.targetDocument = Nothing
End Sub

#変数が構造体でstaticなのはクラスにしようとした名残なので気にしない
#OnTimeでクラスメンバを直接呼べないからモジュール用のままになってるだけです。

Answer 4

gekka様

お忙しい中、恐縮です。
重ね重ね御礼申し上げます。


考え方、理解できました。
ループ処理の中の1ループ分をapplication.onimeで1回subとして
呼び出す（Forループは使用できない）、と言うのがポイントですね？


この考え方で実装を進めて行きます。
ありがとうございました。


P.S.　余談ですが、本件に関連して検証した事項をナレッジとしてここに記しておきます。

　　　　Paragraphs.Count　の処理ですが、処理速度が大変遅いです。
　　　　paragraph数＝3000（ページ数約60ページ）のdocファイルで、count値取得に数秒かかります。
　　　　　→　ループ外で最初にカウントする事にしようと思います。

　　　　また、LoopMethod2の中の
　　　　　Set eachParagraph = value.targetDocument.Paragraphs(value.paragraphIndex)
　　　　の処理ですが、上記のdocファイル（paragraph数＝3000）では、70個目辺りのparagraphの処理以降で
　　　　極端に処理速度が遅くなります。（秒単位で1個処理するごとに2次曲線的に遅くなる）
　　　　　→　まだ解決策は見つけていませんが、何とか工夫してみます。

　　　　Word　VBA、奥が深いですね。。。