Results 1 to 4 of 4

Thread: VBA Word Tables

  1. #1
    New Lounger
    Join Date
    Apr 2014
    Posts
    2
    Thanks
    1
    Thanked 0 Times in 0 Posts

    VBA Word Tables

    Hi,

    For the most part I'm often a trawler finding information to help until now wihich requires me to make my first post. I am an amateur in VBA and most coding so please bear with me.

    I have created a macro in a document that creates and inserts a specific table (for the purpose for purpose of writing up notes with clients I work with)

    It works now flawlessly, with I minor issue. With each time I insert the table I am unable to have the table to be added to the previous tables and have a paragragh gap between each table for it to work.

    When I remove the
    Code:
    Selection.TypeParagraph
    in vba I receive the error message "Run-time error '5992': Cannot access indivual coloumns in this collection because the table has mixed cell widths"

    I can delete the paragraghing manually and the tables join up, but I would like it automated. Macro recorder is of no use here either

    My current code is

    Code:
    Sub addtable()
    
    Selection.MoveDown Unit:=wdScreen, Count:=1
    Selection.TypeParagraph
    
        ThisDocument.Tables.Add Range:=Selection.Range, NumRows:=5, NumColumns:=4, _
                            DefaultTableBehavior:=wdWord9TableBehavior, _
                            AutoFitBehavior:=wdAutoFitFixed
    
        With ThisDocument.Tables(ThisDocument.Tables.Count)
    
    '       Sets Row Height and Columns Widths
    '
    
            .Rows.Height = 25
            .Columns(1).Width = 56
            .Columns(2).Width = 64
            .Columns(3).Width = 368
            .Columns(4).Width = 50
            
    '       Merges Columns togther
    '
            .Columns(1).Cells(1).Merge _
            MergeTo:=.Columns(1).Cells(5)
            .Columns(2).Cells(1).Merge _
            MergeTo:=.Columns(2).Cells(5)
            .Columns(4).Cells(1).Merge _
            MergeTo:=.Columns(4).Cells(5)
            
    '       Sets Labels in Column 3
    '
            .Columns(3).Cells(1).Range.Text = "Relates to action plan:"
            .Columns(3).Cells(2).Range.Text = "Children sighted:"
            .Columns(3).Cells(3).Range.Text = "Observations:"
            .Columns(3).Cells(4).Range.Text = "Discussions:"
            .Columns(3).Cells(5).Range.Text = "Next Visit:"
        End With
    End Sub
    Any suggestions would be of great value

    Cheers

  2. Get our unique weekly Newsletter with tips and techniques, how to's and critical updates on Windows 7, Windows 8, Windows XP, Firefox, Internet Explorer, Google, etc. Join our 480,000 subscribers!

    Excel 2013: The Missing Manual

    + Get this BONUS — free!

    Get the most of Excel! Learn about new features, basics of creating a new spreadsheet and using the infamous Ribbon in the first chapter of Excel 2013: The Missing Manual - Subscribe and download Chapter 1 for free!

  3. #2
    Super Moderator
    Join Date
    May 2002
    Location
    Canberra, Australian Capital Territory, Australia
    Posts
    3,889
    Thanks
    0
    Thanked 188 Times in 172 Posts
    For your existing process, you could probably use:
    Code:
    Sub AddTable()
    Dim Rng As Range, Tbl As Table
    With ActiveDocument
      ' Get the last table's range
      Set Rng = .Tables(.Tables.Count).Range
      With Rng
        ' Find the first character outside the table
        .End = .End
        ' Collapse the range to its end
        .Collapse wdCollapseEnd
        ' Insert a new paragraph
        .InsertParagraphBefore
        ' Collapse the range to its end
        .Collapse wdCollapseEnd
        ' Insert a 1-row by 4-column table
        Set Tbl = .Tables.Add(Range:=Rng, Numrows:=1, NumColumns:=4, _
          DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:=wdAutoFitFixed)
      End With
    End With
    With Tbl
      ' Set Row Height and Columns Widths
      .Rows.Height = 125
      .Columns(1).Width = 56
      .Columns(2).Width = 64
      .Columns(3).Width = 368
      .Columns(4).Width = 50
      With .Columns(3)
        ' Split into 5 rows
        .Cells(1).Split Numrows:=5
        ' Add Labels
        .Cells(1).Range.Text = "Relates to action plan:"
        .Cells(2).Range.Text = "Children sighted:"
        .Cells(3).Range.Text = "Observations:"
        .Cells(4).Range.Text = "Discussions:"
        .Cells(5).Range.Text = "Next Visit:"
      End With
      'Delete the paragraph break separating out table from the previous one
      .Range.Characters.First.Previous.Delete
    End With
    End Sub
    However, given that all you're really trying to do is to add new rows to the existing table, you probably don't need any more than:
    Code:
    Sub AddRows()
    Dim Tbl As Table, i As Long
    With ActiveDocument
      ' Get the last table
      Set Tbl = .Tables(.Tables.Count)
    End With
    With Tbl
      .Rows.Add
      i = .Rows.Count
      ' Split column 3 in the last cell into 5 rows
      .Cell(i, 3).Split Numrows:=5
      .Cell(i, 3).Range.Text = "Relates to action plan:"
      .Cell(i + 1, 3).Range.Text = "Children sighted:"
      .Cell(i + 2, 3).Range.Text = "Observations:"
      .Cell(i + 3, 3).Range.Text = "Discussions:"
      .Cell(i + 4, 3).Range.Text = "Next Visit:"
    End With
    End Sub
    Cheers,

    Paul Edstein
    [MS MVP - Word]

  4. The Following User Says Thank You to macropod For This Useful Post:

    cladinshadows85 (2014-04-29)

  5. #3
    Silver Lounger Charles Kenyon's Avatar
    Join Date
    Jan 2001
    Location
    Madison, Wisconsin, Wisconsin, USA
    Posts
    1,694
    Thanks
    55
    Thanked 63 Times in 61 Posts
    An alternative method would be to save your table (complete with a paragraph mark before it, as an AutoText or Building Blocks entry and simply insert that as needed.

    http://www.addbalance.com/usersguide...utocorrect.htm
    Charles Kyle Kenyon
    Madison, Wisconsin

  6. #4
    New Lounger
    Join Date
    Apr 2014
    Posts
    2
    Thanks
    1
    Thanked 0 Times in 0 Posts
    @macropod, it works like a treat, thankyou :-)

Tags for this Thread

Posting Permissions

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