Solved: Help with tables needed!

[janaboo13]

I'm pretty new to VBA and thanks to this forum, I am learning so much, but I'm stumped with this current issue. We are using a component db management system and have found that creating tables for some of our content that includes graphics is the solution of choice for formatting reasons. We then publish to Word. This process, however, results in a large number of tables in a document. For a 50-page document, the code below works great (even though I hate stepping through ALL the tables.) Besides the tables that are used for formatting reasons, we have a number of tables that are formatted with borders. I would like to search for only those tables to make sure that the correct borders are applied in the resulting Word doc.

We're getting ready to create a much larger doc set and the thought of stepping through each table in those documents is daunting, at best.

I need some help modifying the code below to only search for tables that have specific table heading styles (Table Heading L, Table Heading R, etc.) so that I don't have to search through every table in the document.

If anyone has suggestions on how to do that, I would sooooo appreciate the help!! If you need to see a document to clarify what I need to do, please let me know and I'll post.

Here's the code I'm using now...

'This macro sets the top table border to 1 pt and
' all other horizontable table borders to .5 pt
Sub FixTableBorders()
' Runs through all tables from a user defined start point asking user to indicate whether formatting is to be applied.
' This determines the start point
Response = MsgBox("Start here? Select No to start at beginning of document.", vbYesNoCancel)
If Response = vbYes Then
Selection.GoTo What:=wdGoToTable, Which:=wdGoToNext, Count:=1, Name:=""
' This gives warning message if there are no tables beyond start point.
If Selection.Information(wdWithInTable) = True Then
Else
MsgBox "There are no tables after this position"
End
End If
ElseIf Response = vbNo Then
Selection.HomeKey Unit:=wdStory
Selection.GoTo What:=wdGoToTable, Which:=wdGoToNext, Count:=1, Name:=""
' This gives warning message if there are no tables in the document.
If Selection.Information(wdWithInTable) = True Then
Else
MsgBox "There are no tables in this document"
End
End If
Else
End
End If
' This finds the next table from start point and starts the formatting
Do
Response = MsgBox("Fix border on this table?", vbYesNoCancel)
If Response = vbYes Then
' This selects the table
With Selection
.SelectColumn
.SelectRow
End With
' This formats the table
With Selection.Rows.Borders(wdBorderTop)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth100pt
End With
With Selection.Rows.Borders(wdBorderBottom)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth050pt
End With
With Selection.Rows.Borders(wdBorderHorizontal)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth050pt
End With

' This collapses the selection and moves to the next table or displays the end of tables message
Selection.Collapse wdCollapseEnd
Selection.GoTo What:=wdGoToTable, Which:=wdGoToNext, Count:=1, Name:=""
If Selection.Information(wdWithInTable) = True Then
Else
MsgBox "End of tables in this document"
End
End If
ElseIf Response = vbNo Then
' Selects Table and then collapses to point beyond the table
With Selection
.SelectColumn
.SelectRow
End With
Selection.Collapse wdCollapseEnd
' Looks for next table and loops if found or ends macro
Selection.GoTo What:=wdGoToTable, Which:=wdGoToNext, Count:=1, Name:=""
If Selection.Information(wdWithInTable) = True Then
Else
MsgBox "End of tables in this document"
End
End If
Else
End
End If
Loop
MsgBox "End of tables in this document"
End Sub

[macropod]

Hi janaboo13,

When posting code, please use the VBA code tags.

Try the following. It looks for tables in which the first paragraph is formatted with your 'Table Heading L' Style.
Option Explicit
Dim bEnd As Boolean

Sub FixTableBorders()
' Runs through all tables from a user defined start point asking user to indicate whether formatting is to be applied.
' This determines the start point
Dim Response
If ActiveDocument.Tables.Count = 0 Then
MsgBox "There are no tables in this document"
Exit Sub
End If
bEnd = False
Response = MsgBox("Start here? Select No to start at beginning of document.", vbYesNoCancel)
With Selection
If Response = vbYes Then
' This collapses the selection and moves to the next table or displays the end of tables message
Call GetNextTable
ElseIf Response = vbNo Then
.HomeKey Unit:=wdStory
' This collapses the selection and moves to the next table or displays the end of tables message
Call GetNextTable
Else
End
End If
End With
' This finds the next table from start point and starts the formatting
Do
If bEnd = True Then Exit Do
Response = MsgBox("Fix border on this table?", vbYesNoCancel)
If Response = vbYes Then
' This selects the table
With Selection.Tables(1)
' This formats the table
' the top table border is set to 1 pt and all
' other horizontable table borders to 0.5 pt
With .Rows.Borders(wdBorderTop)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth100pt
End With
With .Rows.Borders(wdBorderBottom)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth050pt
End With
With .Rows.Borders(wdBorderHorizontal)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth050pt
End With
End With
ElseIf Response = vbCancel Then Exit Sub
End If
' This collapses the selection and moves to the next table or displays the end of tables message
Call GetNextTable
Loop
End Sub

Sub GetNextTable()
Dim RngSel As Range, i As Integer
With ActiveDocument
With Selection
If .Information(wdWithInTable) = True Then
.End = .Tables(1).Range.End + 1
.Collapse (wdCollapseEnd)
End If
End With
Set RngSel = .Range(Start:=Selection.Range.End, End:=.Range.End)
For i = 1 To RngSel.Tables.Count
If RngSel.Tables(i).Range.Paragraphs(1).Style = "Table Heading L" Then
.GoTo What:=wdGoToTable, Which:=wdGoToNext, Count:=i, Name:=""
Exit Sub
End If
Next
bEnd = True
MsgBox "There are no more tables in this document"
End With
End Sub

[janaboo13]

Hi Paul!
Thank you for your reply! Forgive me, but I don't know how to use the VBA code tags...can you please give me some directions?

I've tried your code and get this run-time error message.

Run-time error '5941':
The requested member of the collection does not exist

I've copied the code with the code (in red) that gets highlighted in the debug routine, below:

Do
If bEnd = True Then Exit Do
Response = MsgBox("Fix border on this table?", vbYesNoCancel)
If Response = vbYes Then
' This selects the table
With Selection.Tables(1)
' This formats the table
' the top table border is set to 1 pt and all
' other horizontable table borders to 0.5 pt
With .Rows.Borders(wdBorderTop)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth100pt
End With
With .Rows.Borders(wdBorderBottom)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth050pt
End With
With .Rows.Borders(wdBorderHorizontal)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth050pt
End With
End With
ElseIf Response = vbCancel Then Exit Sub
End If
' This collapses the selection and moves to the next table or displays the end of tables message
Call GetNextTable
Loop

Unfortunately, I don't know how to fix this...can you help?

The other thing that happens, whether I choose Yes or No to start at the beginning of the document is that it doesn't seem to be moving through the document when I get the message to fix the border. This may be because of the error, but I'm not sure.

Many thanks! Jan

[macropod]

Hi Jan,

Re:
Hi Paul!
Thank you for your reply! Forgive me, but I don't know how to use the VBA code tags...can you please give me some directions?
The VBA code tags are created by the 'VBA' button that's on the toolbar just above the text pane when you're writing a post. You click on that button then post your code between the two tags.

I've tried your code and get this run-time error message.

Run-time error '5941':
The requested member of the collection does not exist

I've copied the code with the code (in red) that gets highlighted in the debug routine, below:

Do
If bEnd = True Then Exit Do
Response = MsgBox("Fix border on this table?", vbYesNoCancel)
If Response = vbYes Then
' This selects the table
With Selection.Tables(1)
' This formats the table
' the top table border is set to 1 pt and all
' other horizontable table borders to 0.5 pt
Try adding the line:

RngSel.Tables(i).Range.Select
just above the 'Exit Sub' in the 'GetNextTable' sub, speaking of which, you may want to prefix the sub with 'Private', as in:

Private Sub GetNextTable()
That stops it from appearing in Word's macro listings, which is a good thing because you probably won't want to run it on its own.

[janaboo13]

Cheers Paul!
Thank you so much for the education and the solution...it works great!!!

Now, the next challenge is to search for other heading styles (i.e., Table Heading L - Parts or Table Heading L - 8 pt..I have 7 different styles) and apply the same border formatting.

Is this something that can be done in the Private Sub GetNextTable routine? OR, do I have to write another sub routine for each table heading? This approach doesn't seem elegant, so I need your help, please.

Can this line of code include all the different styles in the doc? If so, do I separate each style (in quotes) with a comma?

If RngSel.Tables(i).Range.Paragraphs(1).Style = "Table Heading L" Then
.GoTo What:=wdGoToTable, Which:=wdGoToNext, Count:=i, Name:=""

Many thanks! Jan

[janaboo13]

Hi Paul!
Well, I tried a nested If statement to look for the other Table Heading styles in the GetNextTable sub and it worked!!!

If there is a more elegant way to do this, please let me know!

I'm so excited...this forum is absolutely wonderful!

:rotlaugh:
Jan

[gmaxey]

Jan,

You could use a Case statement rather than nested IF fields:

Select Case RngSel.Tables(i).Range.Paragraphs(1).Style
Case Is = "Heading 1", "Heading 2", Heading 3"
'Do whatever
Case Else
'Do nothing
End Select

[janaboo13]

Hey Greg...thanks! Jan