Thread: [Solved] Create heading row for table
View Single Post
 
Old 12-08-2019, 04:29 PM
macropod's Avatar
macropod macropod is offline Windows 7 64bit Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,963
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

Quote:
Originally Posted by jeffreybrown View Post
This worked except for the first new row did not size with the table.
As I mentioned in my previous reply:
Quote:
Originally Posted by macropod View Post
something in your document is preventing the code from picking up the table width, so the new row's width is independent of the rest of the table's width.
When I look at your table's size in Word, the width is set to 69.9%. For reasons I don't understand, though, in VBA the width is returned as undefined. The following code overcomes that by getting the width of each cell on the first row.
Code:
Sub CleanupTables()
Application.ScreenUpdating = False
Dim Tbl As Table, Rng As Range, c As Long, s As Single, PrefWdthType As Long
For Each Tbl In ActiveDocument.Tables
  With Tbl
    PrefWdthType = .PreferredWidthType: s = 0
    Set Rng = .Range.Characters.First.Previous.Paragraphs.First.Range
    With Rng
      With Tbl.Range
        For c = 1 To .Cells.Count
          If .Cells(c).RowIndex = 1 Then
            s = s + .Cells(c).Width
          Else
            Exit For
          End If
        Next
      End With
      If .Text Like "Table [0-9]*" Then
        .Style = "Caption"
        .ParagraphFormat.Reset
        .End = .End - 1
        .ConvertToTable Separator:=vbTab, NumRows:=1, NumColumns:=1, Format:=wdTableFormatNone, ApplyHeadingRows:=True
        With .Tables(1)
          .PreferredWidthType = wdPreferredWidthPoints
          .PreferredWidth = s
          .Cell(1, 1).PreferredWidth = 0
          .Rows.LeftIndent = Tbl.Rows.LeftIndent
          .RightPadding = Tbl.LeftPadding
          .LeftPadding = Tbl.RightPadding
        End With
        .Characters.Last.Next.Text = vbNullString
        With .Tables(1)
          .PreferredWidthType = wdPreferredWidthPoints
          .PreferredWidth = s
          .Range.Cells.PreferredWidthType = PrefWdthType
          .PreferredWidthType = PrefWdthType
        End With
      End If
    End With
  End With
Next
Application.ScreenUpdating = True
End Sub
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote