Consulting

Results 1 to 6 of 6

Thread: Word VBA - Dynamic table creation based on Headings

  1. #1

    Word VBA - Dynamic table creation based on Headings

    Hi,
    First: I'm not looking for a table of content. Not like the one Word offers at least.

    My document format looks some kind like this: underlined text is the "name" of the chapter, you might say, and is the actual text I want to populate a table with.
    Heading 1: Unique name (actually in number format).
    Heading 2: The actual name (underline) contain the text I want.
    Heading 3: Actual data. in a number list

    Heading 1 Experiment #1
    Heading 2 Critical
    Heading 3 Item 1.1
    Heading 3 Item 1.2
    Heading 2 Deviations
    Heading 3 Item 2.1
    Heading 3 Item 2.2
    Heading 2 Remark
    Heading 3 Item 3.1
    Heading 3 Item 3.2




    From this, I want a table (with dynamic length, based on number of heading 1's).
    Note that Experiement #2 dont have any ciritcal items in this example.

    Experiment type Text
    Experiment #1 Critical
    Item 1.1
    Item 1.2
    Deviations

    Item 2.1
    Item 2.2
    Remark

    Item 3.1
    Item 3.2
    Experiment #2 Deviations

    Item 2.1
    Item 2.2
    Remark Item 3.1
    Item 3.2


    Appreciate any help anyone can provide some helpfull insight, even better if anyone has code for this.

    I want to create a table, to make a summary
    The psudo code, in my head

    H1_Count = ThisDocument.Heading1.Count()
    iCol = 3; // 3 columns
    iRow = H1_Count +1  // Heading 1 count + header
    Table = CreateTable(iCol, iRow)
    row = Table.AddRow()
    row(0,"Experiment") 
    row(1,"Type") 
    row(2,"Text") 
    foreach H1 in ThisDocument:
              row = Table.AddRow()
              row(0,H1.Text) // first column filled with experiment #
              foreach  H2 in ThisDocument:
                       row(1,H2.Text) // second column filled with Critical/Deviation/Remarks
                       foreach  H3 in ThisDocument:
                                 row(2,H3.Text) // third column filled with all items
    



  2. #2
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    3,607
    Location
    The simplest way would be to have your macro create a normal Word Table of Contents (without page #s), convert that to text, replace the relevant paragraph breaks with tabs, then convert the lot to a Word table.
    Cheers
    Paul Edstein
    [MS MVP - Word]

  3. #3
    Thanks for your reply.

    My code just leaves the TOC in plain text in cell (0,0)

        ThisDocument.Tables(1).Delete    ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=4, NumColumns:=3
        
        Set myRange = Selection.Range
        ActiveDocument.TablesOfContents.Add _
            Range:=myRange, _
            UseFields:=False, _
            UseHeadingStyles:=True, _
            IncludePageNumbers:=False, _
            LowerHeadingLevel:=3, _
            UpperHeadingLevel:=1, _
            AddedStyles:="myStyle, yourStyle"
            
        For Each nextTOC In ActiveDocument.TablesOfContents
            nextTOC.Range.Fields.Unlink
        Next

  4. #4
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    3,607
    Location
    Since you're not doing as I suggested, it's hardly surprising you're having problems.
    Cheers
    Paul Edstein
    [MS MVP - Word]

  5. #5
    Quote Originally Posted by macropod View Post
    Since you're not doing as I suggested, it's hardly surprising you're having problems.
    Elaborate please? I'm not the best vba programmer. It sounds like you're suggeting this is a piece of cake.

  6. #6
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    3,607
    Location
    Try:
    Sub Make_Table()
    Application.ScreenUpdating = False
    Dim Tbl As Table, Rng As Range, Para As Paragraph
    With ActiveDocument
      .TablesOfContents.Add Range:=.Range(0, 0), UseHeadingStyles:=True, IncludePageNumbers:=False
      Set Rng = .TablesOfContents(1).Range
      With Rng
        .Fields.Unlink
        For Each Para In .Paragraphs
          Select Case Para.Style
            Case "TOC 2"
              If Para.Range.Previous.Style = "TOC 2" Then Para.Range.InsertBefore vbTab & vbTab
              If Para.Range.Previous.Style = "TOC 3" Then Para.Range.InsertBefore vbTab
            Case "TOC 3"
              If Para.Range.Previous.Style = "TOC 1" Then Para.Range.InsertBefore vbTab
              If Para.Range.Previous.Style = "TOC 3" Then Para.Range.InsertBefore vbTab & vbTab
          End Select
        Next
        With .Find
          .ClearFormatting
          .Replacement.ClearFormatting
          .Format = True
          .Forward = True
          .Wrap = wdFindStop
          .Text = "^p"
          .Replacement.Text = "^t"
          .Style = "TOC 1"
          .Execute Replace:=wdReplaceAll
          .Style = "TOC 2"
          .Execute Replace:=wdReplaceAll
        End With
        .Style = wdStyleNormal
        .Font.Reset
        .ConvertToTable Separator:=vbTab, Numcolumns:=3
      End With
    End With
    Application.ScreenUpdating = True
    End Sub
    Cheers
    Paul Edstein
    [MS MVP - Word]

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •