I have a report that is produced weekly for each of my customers. My company requires that the document is formatted a certain way. One of the formatting requirements is to find the table with the keyword "BUDGETS", which seems to be in a table and is the banner row. The next two rows have 2 columns each but the columns need to be distributed as to be the same width.
It's easy enough to find the keyword, then move down to the next row, and select the row. Then I should be able to use Selection.Columns.DistributeWidth but when I do, I get an error stating that Columns is not part of the object.
I've tried tons of things. I separated the attempts by a comment line and a number. The most recent code at the top doesn't work either. :-(
function FindAndDistributeColumns(oActiveDocument As Word.Document, sTargetString As String) As Boolean
Dim bStat As Boolean
bStat = False
'------------------------------------------------------------------------------------------------------- 1
Dim wdDoc As Word.Document, wdRng As Word.Range
Set wdDoc = oActiveDocument
With wdDoc
Set wdRng = .Range(0, 0)
With .Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = sTargetString
.Forward = True
.Format = False
.Wrap = wdFindStop
.MatchWildcards = True
End With
Do While .Find.Execute
If .Information(wdWithInTable) = True Then
wdRng.End = .End
TableNo = wdRng.Tables.Count
If TableNo > 0 Then
Dim myTable As Word.Table
Set myTable = oActiveDocument.Tables(TableNo)
Dim i As Integer
MsgBox myTable.Rows.Count
MsgBox myTable.Columns.Count
End If
End If
.Collapse wdCollapseEnd
Loop
End With
End With
'------------------------------------------------------------------------------------------------------- 2
' Dim myRange As Range
'
' Set myRange = oActiveDocument.Content
'
' myRange.Select
'
' Selection.Font.Bold = wdToggle
'
' myRange.Find.Execute FindText:=sTargetString
'' Selection.RowSelectMode = True
' 'Selection
'
' If myRange.Find.Found Then
'
' If Not Selection Is Nothing Then
'
' myRange.End = myRange.EndOf(unit:=wdRow)
' myRange.End = myRange.Start myRange.EndOf(unit:=wdRow)
' myRange.Select
' Selection.MoveLeft unit:=wdWord, Count:=1, Extend:=wdExtend
' Selection.MoveRight Unit:=wdWord, Count:=1, Extend:=wdExtend
' ' Selection.Rows(1).DistributeWidth
' End If
'
' End If
''
' With oActiveDocument.Content.Find
' .Text = "BUDGETS"
' .Forward = True
' .Wrap = wdFindStop
' .Execute
'
' If .Found Then
' Selection.MoveDown Unit:=wdLine, Count:=1
' Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
' Selection.MoveRight Unit:=wdWord, Count:=4, Extend:=wdExtend
' Selection.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdExtend
' ' Selection.Columns.DistributeWidth
' End If
' End With
'------------------------------------------------------------------------------------------------------- 3
'Dim tTable As Word.Table
' Dim wdDoc As Word.Document, t As Long
' Set wdDoc = oActiveDocument
' With wdDoc
' For t = 1 To .Tables.Count
' With .Tables(t).Range.Find
' .ClearFormatting
' .Replacement.ClearFormatting
' .Text = sTargetString
' .Forward = True
' .Format = False
' .Wrap = wdFindStop
' .MatchWildcards = True
' .Execute
' If .Found = True Then
' MsgBox t
' Selection.MoveDown unit:=wdLine, Count:=1
'
' End If
' End With
' Next
' End With
'
' Dim r As Row
'
' For Each tTable In oActiveDocument.Tables
' tTable.Select
' MsgBox tTable.Rows.Count
' If tTable.Rows.Count > 1 Then
' Dim i As Integer
' For i = 1 To tTable.Rows.Count
' Set r = tTable.Rows(i)
' r.Select
'
' r.Cells.DistributeWidth
'
' Next i
' End If
' Next tTable
'
' With Selection.Find
'
' .Forward = True
' .MatchCase = True
' .Text = "BUDGETS"
' .Execute
'
' If .Found Then
' bStat = True
' Selection.MoveDown unit:=wdLine, Count:=1
' Selection.Columns.Select
' Selection.Columns.DistributeWidth
' End If
'
' End With
'
''------------------------------------------------------------------------------------------------------- 4
' oActiveDocument
' Application.ScreenUpdating = True
' With oActiveDocument.Range
' With .Find
' .ClearFormatting
' ' .Replacement.ClearFormatting
' .Text = sTargetString
' ' .Replacement.Text = ""
' .Forward = True
' .MatchCase = True
' .Wrap = wdFindStop
' .Format = False
' .MatchWildcards = True
' .Execute
' End With
'
' If .Find.Found Then
' bStat = True
' Selection.MoveDown unit:=wdLine, Count:=1
' ' Selection.MoveRight unit:=wdCell, Count:=1
'' Selection.Cells.DistributeWidth
'
' If .Information(wdWithInTable) = True Then
' MsgBox .Rows.Count
' MsgBox .Tables.Count
' Selection.Select
' Selection.MoveEnd
'
'
' Selection.Columns.DistributeWidth
' End If
'
'
'
'
' End If
'End With
'------------------------------------------------------------------------------------------------------- 5
' With oActiveDocument.Content.Find
'
' .Forward = True
' .MatchCase = True
' .Text = "BUDGETS"
' .Execute
'
' If .Found Then
' bStat = True
' Selection.MoveDown unit:=wdLine, Count:=1
' Selection.Columns.Select
' Selection.Columns.DistributeWidth
' End If
'
' End With
FindAndDistributeColumns = bStat
End Function
None of those code snippets work. I would appreciate some help with this one - it seems SO EASY! If anyone would like the Word document I'm working from, I can provide via DM.
Thanks in advance,
Ryan
CodePudding user response：
Just looping tables:
Dim tbl As Table, tblP As Table, rw As Long, allTables As New Collection
For Each tbl In ActiveDocument.Tables
allTables.Add tbl
Next tbl
'check each table
Do While allTables.Count > 0
Set tblP = allTables(1)
allTables.Remove 1
If tblP.Cell(1, 1).Range.Text Like "Budget*" Then
For rw = 2 To tblP.Rows.Count
tblP.Rows(rw).Cells.DistributeWidth
Next rw
'Exit Sub 'if expecting only one matching table
End If
'check for sub-tables and add to collection for processing
For Each tbl In tblP.Tables
allTables.Add tbl
Next tbl
Loop
CodePudding user response：
As I said in my comment above, the issue was nested tables. Here's the code solution.
Dim i, j, k As Integer, tbl As Table, tblP As Table, rw As Long
For Each tbl In oActiveDocument.Tables
tbl.Select
For i = 1 To tbl.Tables.Count
Set tblP = tbl.Tables(i)
For j = 1 To tblP.Rows.Count
For k = 1 To tblP.Rows(j).Cells.Count
If Trim(tblP.Rows(j).Cells(k).Range.Text) Like "*BUDGETS*" Then
bStat = True
For rw = 2 To tblP.Rows.Count
tblP.Rows(rw).Cells.DistributeWidth
Next rw
FindAndDistributeColumns = bState
Exit Function 'if expecting only one matching table
End If
Next k
Next j
Next i
Next tbl
Thanks all!