Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 12-07-2019, 01:52 PM
jeffreybrown jeffreybrown is offline Create heading row for table Windows 10 Create heading row for table Office 2016
Expert
Create heading row for table
 
Join Date: Apr 2016
Posts: 673
jeffreybrown has a spectacular aura aboutjeffreybrown has a spectacular aura about
Default Create heading row for table

I have many table with a title directly above the table. This code below works just fine to add that header as part of the table in the newly created row 1; however, I just ran into a table that has vertically merged cells and therefore throwing an error when running the code.



I know merge cells are not ideal, but in this situation they will have to remain.

Is there a way to access the table even with the merged cells and still add the text above the table as the title in row 1?

In the attachment there is a before and after?

Code:
Sub CleanupTables()
    Dim aTbl    As Table
    Dim aRng    As Range
    Dim aRow    As Row
    
    Application.ScreenUpdating = False
    
    For Each aTbl In ActiveDocument.Tables
        Set aRng = aTbl.Range
        aRng.MoveStart Unit:=wdParagraph, Count:=-1
        aRng.Select
        ActiveWindow.ScrollIntoView aRng, True
        With aTbl                        
            If MsgBox("Does this table have a table name", vbYesNo) = vbYes Then
                Set aRow = aTbl.Rows.Add(BeforeRow:=aTbl.Rows(1))
                aRow.Range.Cells.Merge
                Set aRng = aRng.Paragraphs(1).Range
                aRng.MoveEnd Unit:=wdCharacter, Count:=-1
                aRow.Range.Cells(1).Range.FormattedText = aRng.FormattedText
                aRng.Paragraphs(1).Range.Delete
                aRow.Borders(wdBorderTop).LineStyle = wdLineStyleNone
                aRow.Borders(wdBorderLeft).LineStyle = wdLineStyleNone
                aRow.Borders(wdBorderRight).LineStyle = wdLineStyleNone
                aRow.Range.Style = "Caption"
                aRow.Range.ParagraphFormat.Reset
            End If
        End With
    Next aTbl
            
    Application.ScreenUpdating = True
    
End Sub
Attached Files
File Type: docm Table 1.docm (26.2 KB, 10 views)
Reply With Quote
  #2  
Old 12-08-2019, 12:14 AM
macropod's Avatar
macropod macropod is offline Create heading row for table Windows 7 64bit Create heading row for table Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
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

You should be able to use something like:
Code:
Sub CleanupTables()
Application.ScreenUpdating = False
Dim Tbl As Table, Rng As Range, PrefWdthType As Long, PrefWwdthVal As Single, bFit As Boolean
For Each Tbl In ActiveDocument.Tables
  With Tbl
    Set Rng = .Range.Characters.First.Previous.Paragraphs.First.Range
    If Rng.Text Like "Table [0-9]*" Then
      Rng.ParagraphFormat.TabStops.ClearAll
      bFit = .AllowAutoFit
      .AllowAutoFit = False
      PrefWdthType = .PreferredWidthType
      PrefWwdthVal = .PreferredWidth
      With Rng
        .End = .End - 1
        .ConvertToTable Separator:=vbTab, NumRows:=1, NumColumns:=1, Format:=wdTableFormatNone, ApplyHeadingRows:=True
        With .Tables(1)
          If PrefWwdthVal <> 9999999 Then
            .PreferredWidthType = PrefWdthType
            .PreferredWidth = PrefWwdthVal
          End If
          With .Range.Cells(1).Range
            .Style = "Caption"
            .ParagraphFormat.Reset
          End With
        End With
      End With
      .Range.Characters.First.Previous.Delete
      .AllowAutoFit = bFit
    End If
  End With
Next
Application.ScreenUpdating = True
End Sub
In a general sense, the above works, but 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.
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #3  
Old 12-08-2019, 06:39 AM
jeffreybrown jeffreybrown is offline Create heading row for table Windows 10 Create heading row for table Office 2016
Expert
Create heading row for table
 
Join Date: Apr 2016
Posts: 673
jeffreybrown has a spectacular aura aboutjeffreybrown has a spectacular aura about
Default

Hi Paul,

This worked except for the first new row did not size with the table.

I found a thread where you suggested to remove the table and place in Excel, unmerge the cells there and then put back into Word.

This might work well for my needs as I don't think table with vertically merged cells will be a large number.

So, my thought, do as I mentioned above, but run my original code but add a skip when vertically merged cells are identified. As those tables are identified, I can write down the table number and deal with them one by one.

I found this, but is this the best to skip? I only need to display and then skip if vertical merged cells are identified, but I don't need the message that gives the error description.

Code:
Sub tableformat()
    Dim i As Long
    Dim oRow As Row
    Dim oCol As Column
    On Error GoTo ErrHandler
    For i = 1 To Selection.Tables.Count
        For Each oRow In Selection.Tables(i).Rows
        Next oRow
NextStep:
        For Each oCol In Selection.Tables(i).Columns
        Next oCol
NextTable:
    Next i
    Exit Sub
ErrHandler:
    Select Case Err
        Case 5991
            MsgBox "Table #" & i & " has vertically merged cells"
            Resume NextStep
        Case Else
            MsgBox "Error " & Err.Number & ": " & _
                Err.Description & " in table #" & i
            Resume NextTable
    End Select
End Sub
Note: On further looking, I see the two errors are for checking for merged rows and then checking merged columns. In my case, the original error in post #1 was due to the vertically merged and not the horizontal. So far in all the tables I've been cleaning up have multiple column merged and never an error adding the top row.
Reply With Quote
  #4  
Old 12-08-2019, 04:29 PM
macropod's Avatar
macropod macropod is offline Create heading row for table Windows 7 64bit Create heading row for table Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
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
  #5  
Old 12-08-2019, 06:14 PM
Guessed's Avatar
Guessed Guessed is offline Create heading row for table Windows 10 Create heading row for table Office 2016
Expert
 
Join Date: Mar 2010
Location: Canberra/Melbourne Australia
Posts: 3,932
Guessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant future
Default

I would do it this way
Code:
Sub CleanupTables2()
  Dim aTbl    As Table
  Dim aRng    As Range
  Dim aRow    As Row
  Dim aRng2    As Range
  Dim dblEnd As Double
  Dim aCell As Cell
  Dim iCounter As Integer
  
  On Error GoTo errHandle
  
  For iCounter = 1 To ActiveDocument.Tables.Count
    Set aTbl = ActiveDocument.Tables(iCounter)
    Set aRng = aTbl.Range
    aRng.MoveStart Unit:=wdParagraph, Count:=-1
    aRng.Select
    ActiveWindow.ScrollIntoView aRng, True
    With aTbl
      If MsgBox("Does this table have a table name", vbYesNo) = vbYes Then
        dblEnd = aTbl.Range.End
        aTbl.Rows.Add
        Set aRng2 = ActiveDocument.Range(dblEnd, aTbl.Range.End)
        aRng2.Cells.Merge
        Set aRng2 = ActiveDocument.Range(aTbl.Range.Start, dblEnd)
        aRng2.Relocate Direction:=wdRelocateDown
        Set aRng = aRng.Paragraphs(1).Range
        aRng.MoveEnd Unit:=wdCharacter, Count:=-1
        Set aCell = aTbl.Cell(1, 1)
        aCell.Range.FormattedText = aRng.FormattedText
        aRng.Paragraphs(1).Range.Delete
        aCell.Borders(wdBorderTop).LineStyle = wdLineStyleNone
        aCell.Borders(wdBorderLeft).LineStyle = wdLineStyleNone
        aCell.Borders(wdBorderRight).LineStyle = wdLineStyleNone
        aCell.Range.Style = "Caption"
        aCell.Range.ParagraphFormat.Reset
      End If
    End With
NextTable:
  Next iCounter
  
  Exit Sub

errHandle:
  MsgBox "Error " & Err.Number & ": " & Err.Description & " in selected table"
  aTbl.Range.HighlightColorIndex = wdPink
  Resume NextTable
End Sub
__________________
Andrew Lockton
Chrysalis Design, Melbourne Australia
Reply With Quote
  #6  
Old 12-08-2019, 06:51 PM
jeffreybrown jeffreybrown is offline Create heading row for table Windows 10 Create heading row for table Office 2016
Expert
Create heading row for table
 
Join Date: Apr 2016
Posts: 673
jeffreybrown has a spectacular aura aboutjeffreybrown has a spectacular aura about
Default

Thank you both for your replies. I'm on the road right now with no computer access. I'll be able to test next weekend.
Reply With Quote
  #7  
Old 12-15-2019, 04:49 PM
jeffreybrown jeffreybrown is offline Create heading row for table Windows 10 Create heading row for table Office 2016
Expert
Create heading row for table
 
Join Date: Apr 2016
Posts: 673
jeffreybrown has a spectacular aura aboutjeffreybrown has a spectacular aura about
Default

Thanks again to both of you. I just got back and these two options work well. Once I get back to work I can see which one will fit in best.
Reply With Quote
Reply

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
Create heading row for table Want to copy & paste a table underneath itself x no. of time, table found through style heading name fly545 Word VBA 11 01-16-2020 05:53 PM
Can I create a page number from a non-Heading style? techwriter3k Word 9 09-25-2019 06:58 AM
Deleting Blank Space between table heading and table rows Pete Jones Word Tables 5 01-22-2018 04:11 PM
Create heading row for table Heading row disappears from table styles when pasted table is selected andrewballem Word Tables 2 11-12-2013 05:18 AM
Create heading row for table Create and save custom heading style ubns Word 3 08-01-2012 09:42 PM

Other Forums: Access Forums

All times are GMT -7. The time now is 05:13 AM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2024, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2024 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft