none
Word VBAを用いて目次の内容を抽出する方法についての質問 RRS feed

  • 質問

  • お世話になります。

    Word2013のユーザです。

    Word VBAを用いて、目次の内容(各見出しのレベル、見出しの内容、ページ番号)を抽出するにはどのようなコードで実現できるでしょうか。内容については目次の更新を行う前と更新を行った後の双方を取得したいのですが、このようなことは可能でしょうか。

    Word VBAのオンラインリファレンス、書籍、ネット上の情報、本サイトの過去ログ等を一通り探してみたつもりですが、みつけられませんでした。ご教授いただければ幸いです。

    よろしくお願いいたします。

    2016年6月1日 1:58

回答

  • こんな感じ?

    Sub Test()
        Dim doc As Document
        Set doc = ActiveDocument
        
        Dim f As Field
        For Each f In doc.Fields
            'Debug.Print f.Code
            Dim part As String
            part = Trim(f.Code)
            If (Len(part) > 4) Then
                part = Trim(Left(Trim(f.Code), 4))
            End If
            
            If part = "TOC" Then
                Dim colBefore As New Collection
                Dim colAfter As New Collection
                
                Dim p As Paragraph
                For Each p In f.Result.Paragraphs
                    colBefore.Add p.Range.Text
                    Debug.Print p.Range.Text
                Next
                
                f.Update 'うまく更新できない?
                
                For Each p In f.Result.Paragraphs
                    colAfter.Add p.Range.Text
                Next
                
                Dim isChanged As Boolean
                isChanged = False
                If (colBefore.Count <> colAfter.Count) Then
                    isChanged = True
                Else
                    Dim index As Integer
                    For i = 1 To colBefore.Count Step 1
                        If (colBefore(i) <> colAfter(i)) Then
                            isChanged = True
                            Exit For
                        End If
                    Next
                End If
                
                Exit Sub
            End If
        Next
    End Sub
    Sub Test2()
        Dim doc As Document
        Set doc = ActiveDocument
        Dim toc As TableOfContents
        For Each toc In doc.TablesOfContents
            Dim p As Paragraph
            Dim colBefore As New Collection
            For Each p In toc.Range.Paragraphs
                colBefore.Add p.Range.Text
                Debug.Print p.Range.Text
            Next
        Next
        Dim f As Field
        Set f = doc.Range.Fields(1)
        f.Update
    End Sub

    #昼休み時間切れなのでUpdateに関しては調査し切れてません


    個別に明示されていない限りgekkaがフォーラムに投稿したコードにはフォーラム使用条件に基づき「MICROSOFT LIMITED PUBLIC LICENSE」が適用されます。(かなり自由に使ってOK!)

    2016年6月1日 3:59
  • こんにちは。

    方法は色々あるかと思いますが、TablesOfContentsオブジェクトから情報を取得するのはいかがでしょうか。

    Option Explicit
    
    Public Sub Sample()
      GetTocInfo '更新前目次情報
      
      '適当な文字を挿入してページ番号をずらした後目次更新
      With ActiveDocument.TablesOfContents.Item(1)
        .Range.Next.InsertAfter String(10000, "*")
        .Update
      End With
      
      GetTocInfo '更新後目次情報
    End Sub
    
    Public Sub GetTocInfo()
      Dim i As Long
      Dim s As String
      Dim v As Variant
      
      With ActiveDocument.TablesOfContents
        If .Count > 0 Then
          With .Item(1).Range.Paragraphs
            For i = 1 To .Count
              s = Left(.Item(i).Range.Text, Len(.Item(i).Range.Text) - 1) '改行除外
              If Len(s) > 0 Then
                v = Split(s, ChrW(&H9)) '水平タブで分割
                Debug.Print "----------"
                Debug.Print "スタイル:" & .Item(i).Style
                Debug.Print "内容:" & v(LBound(v))
                Debug.Print "ページ番号:" & v(UBound(v))
                Debug.Print "----------"
              End If
            Next
          End With
        End If
      End With
    End Sub



    ちなみに、上記コードは目次が文書中に一つしかないことを想定しています。
    2016年6月1日 4:32

すべての返信

  • こんな感じ?

    Sub Test()
        Dim doc As Document
        Set doc = ActiveDocument
        
        Dim f As Field
        For Each f In doc.Fields
            'Debug.Print f.Code
            Dim part As String
            part = Trim(f.Code)
            If (Len(part) > 4) Then
                part = Trim(Left(Trim(f.Code), 4))
            End If
            
            If part = "TOC" Then
                Dim colBefore As New Collection
                Dim colAfter As New Collection
                
                Dim p As Paragraph
                For Each p In f.Result.Paragraphs
                    colBefore.Add p.Range.Text
                    Debug.Print p.Range.Text
                Next
                
                f.Update 'うまく更新できない?
                
                For Each p In f.Result.Paragraphs
                    colAfter.Add p.Range.Text
                Next
                
                Dim isChanged As Boolean
                isChanged = False
                If (colBefore.Count <> colAfter.Count) Then
                    isChanged = True
                Else
                    Dim index As Integer
                    For i = 1 To colBefore.Count Step 1
                        If (colBefore(i) <> colAfter(i)) Then
                            isChanged = True
                            Exit For
                        End If
                    Next
                End If
                
                Exit Sub
            End If
        Next
    End Sub
    Sub Test2()
        Dim doc As Document
        Set doc = ActiveDocument
        Dim toc As TableOfContents
        For Each toc In doc.TablesOfContents
            Dim p As Paragraph
            Dim colBefore As New Collection
            For Each p In toc.Range.Paragraphs
                colBefore.Add p.Range.Text
                Debug.Print p.Range.Text
            Next
        Next
        Dim f As Field
        Set f = doc.Range.Fields(1)
        f.Update
    End Sub

    #昼休み時間切れなのでUpdateに関しては調査し切れてません


    個別に明示されていない限りgekkaがフォーラムに投稿したコードにはフォーラム使用条件に基づき「MICROSOFT LIMITED PUBLIC LICENSE」が適用されます。(かなり自由に使ってOK!)

    2016年6月1日 3:59
  • こんにちは。

    方法は色々あるかと思いますが、TablesOfContentsオブジェクトから情報を取得するのはいかがでしょうか。

    Option Explicit
    
    Public Sub Sample()
      GetTocInfo '更新前目次情報
      
      '適当な文字を挿入してページ番号をずらした後目次更新
      With ActiveDocument.TablesOfContents.Item(1)
        .Range.Next.InsertAfter String(10000, "*")
        .Update
      End With
      
      GetTocInfo '更新後目次情報
    End Sub
    
    Public Sub GetTocInfo()
      Dim i As Long
      Dim s As String
      Dim v As Variant
      
      With ActiveDocument.TablesOfContents
        If .Count > 0 Then
          With .Item(1).Range.Paragraphs
            For i = 1 To .Count
              s = Left(.Item(i).Range.Text, Len(.Item(i).Range.Text) - 1) '改行除外
              If Len(s) > 0 Then
                v = Split(s, ChrW(&H9)) '水平タブで分割
                Debug.Print "----------"
                Debug.Print "スタイル:" & .Item(i).Style
                Debug.Print "内容:" & v(LBound(v))
                Debug.Print "ページ番号:" & v(UBound(v))
                Debug.Print "----------"
              End If
            Next
          End With
        End If
      End With
    End Sub



    ちなみに、上記コードは目次が文書中に一つしかないことを想定しています。
    2016年6月1日 4:32
  • gekka様、お昼休みの貴重な時間をいただきまして、大変ありがとうございました。Test()とTest2()のコードを拝見しながら、こちらでも実験をさせて頂いてますが、やりたいことの見通しがついてきました。Updateに関しても、意図したように動作しているようにみえます。

    Word VBAを用いる初めての経験でしたので、非常に参考になりました。深謝いたします。



    • 編集済み tocamega 2016年6月3日 8:02
    2016年6月3日 8:00
  • きぬあさ様、大変有用なサンプルコードをいただき、誠にありがとうございました。目次中の各内容とページ番号は水平タブで仕切られているのですね。また、目次が複数ある場合は、ActiveDocument.TablesOfContents.Countで目次の数を取得しておいて、i番目の目次はTablesOfContents(i)で参照出来ると理解しました。これから実験してみようと思います。ご助言に感謝いたします。


    • 編集済み tocamega 2016年6月3日 8:30
    2016年6月3日 8:26