I'm very new to vba and word macros. I'm having an issue where I'm exporting a document to word and a few of the tables exceed page width. I was wondering if there is a way to check if each table is within page width and, if not, ONLY target the tables that have exceeded page width and auto fit those tables to the window.
Here is some code that autofits every table in the document to the window:
Sub tablesAutoFit()
Dim table As table
For Each table In ActiveDocument.Tables
table.AutoFitBehavior (wdAutoFitWindow)
table.AllowAutoFit = False
Next
End Sub
I want to know if there is a way to just autofit the tables that exceed page width, not every table in the document.
Thanks
In order to determine whether a table "fits" on a page it's necessary to determine the table width and compare it to the page width. The following example assumes the table contains no horizontally merged cells, so that the columns can be addressed. If that's not the case, you need to "walk" the cells in a(ny) row to get their widths.
Sub TableWidth()
Dim tbl As Word.Table
Dim col As Word.Column
Dim tblWidth As Double, pgWidth As Double
Dim pgSetup As Word.PageSetup
Set pgSetup = ActiveDocument.PageSetup
pgWidth = pgSetup.PageWidth - pgSetup.LeftMargin - pgSetup.RightMargin
Set tbl = ActiveDocument.Tables(1)
For Each col In tbl.Columns
tblWidth = tblWidth + col.width
Next
If pgWidth < tblWidth Then
tbl.AutoFitBehavior wdAutoFitWindow
End If
Debug.Print tblWidth, pgWidth
End Sub
Related
I'm very new to VBA. I review reports in MS Word from my co-workers on a daily basis and need to make sure that all instances of table borders of 1/2pt be converted to 3/4pt.
There are also instances of thicker border weights up to 1 1/2pt. But I only need to make sure that the minimum weight is 3/4pt.
This is my code so far (that I modified from this post) but it applies the weight to ALL BORDERS and only seems to work for one table in each document.
Sub BorderWeight()
Dim myTable As Table
Dim r As Variant
Set myTable = ThisDocument.Tables(1)
For Each r In myTable.Rows ' <-- loop through all rows in table
r.Borders(wdBorderBottom) = wdLineWidth075pt
Next r
End Sub
Any help is much appreciated.
Using MS Word VBA. I already have a nice macro that autofits all table widths to the window size (margin to margin).
I'm looking to do something similar to autofit all of the table row heights to display all of the text in each row. Currently, the table rows only display one line, and then the text wraps below and is not visible.
Any help is appreciated. Code is below:
Sub ResizeAllTables()
Dim oTbl As Table
For Each oTbl In ActiveDocument.Tables
oTbl.AutoFitBehavior wdAutoFitWindow
Next oTbl
End Sub
You are looking for the Row.HeightRule property. Specifically, you will want it to be set to wdRowHeightAuto which is
The row height is adjusted to accommodate the tallest value in the row.
So using your example I would imagine it would look something like this
Sub ResizeAllTables()
Dim oTbl As Table
For Each oTbl In ActiveDocument.Tables
oTbl.Rows.HeightRule = wdRowHeightAuto
Next oTbl
End Sub
I have to create documents that have large tables of data copied into them from Excel. The tables can be hundreds of rows long and generally ~20 columns wide. Many of the columns have been merged vertically to enhance readability and group sets of data.
I have been able to write a macro that will fully format the entire table, except I have not been able to figure out how to automatically prevent the Vertically Merged cells from breaking/splitting across multiple pages. To do it manually, you select all of the rows in the merger except for the last one and then you turn on "Keep With Next" in the paragraph settings. I thought this would be easy to do, but you can not access individual rows in VBA if there are any vertically merged cells in the table.
Does anyone have an idea how to automatically go through the rows and set the "Keep With Next" property for groups of rows that have been merged together?
Here is an example of how Word normally handles vertically merged cells across tables:
This is how I would like it to look, with doing all the work manually:
Yes, working with merged cells in Word (and Excel for that matter) is quite annoying.
This can be done, though, by accessing individual cells in table. I have written the following Sub Routine below that should work for you. I assumed that you had at least one column with no vertically merged cells in it and that you only had one column that controlled the length of the merged block. Although adding more controlling columns should be easy.
Sub MergedWithNext() 'FTable As Table)
Dim Tester As String
Dim FTable As Table
Dim i As Integer
Dim imax As Integer
Dim RowStart As Integer
Dim RowEnd As Integer
Dim CNMerged As Integer
Dim CNNotMerged As Integer
Dim CNMax As Integer
CNMerged = 2 'A column number that is vertically merged that you don't want to split pages
CNNotMerged = 1 'A column number that has no vertical mergers
Set FTable = Selection.Tables(1)
With FTable
imax = .Rows.Count
CNMax = .Columns.Count
'Start with no rows kept with next
ActiveDocument.Range(Start:=.Cell(1, 1).Range.Start, _
End:=.Cell(imax, CNMax).Range.End).ParagraphFormat.KeepWithNext = False
On Error Resume Next
For i = 2 To imax 'Assume table has header
Tester = .Cell(i, CNMerged).Range.Text 'Test to see if cell exists
If Err.Number = 0 Then 'Only the first row in the merged cell will exist, others will not
'If you are back in this If statement, then you have left the previous block of rows
'even if that was a block of one. The next If statement checks to see if the previous
'row block had more than one row. If so it applies the "KeepWithNext" property
If (RowEnd = (i - 1)) Then
'.Cell(RowStart, 1).Range.ParagraphFormat.KeepWithNext = True
ActiveDocument.Range(Start:=.Cell(RowStart, CNNotMerged).Range.Start, _
End:=.Cell(RowEnd - 1, CNNotMerged).Range.End).ParagraphFormat.KeepWithNext = True
'Use RowEnd - 1 because you don't care if the whole merged block stays with the next
'row that is not part of the merger block
End If
RowStart = i 'Beginning of a possible merger block
RowEnd = 0 'Reset to 0, not really needed, used for clarity
Else
RowEnd = i 'This variable will be used to determine the last merged row
Err.Clear
End If
If i = imax Then 'Last Row
If (RowStart <> imax) Then
ActiveDocument.Range(Start:=.Cell(RowStart, CNNotMerged).Range.Start, _
End:=.Cell(imax - 1, CNNotMerged).Range.End).ParagraphFormat.KeepWithNext = True
'Use imax - 1 because you don't care if the whole merged block stays with the next
'row that is not part of the merger block
End If
End If
Next i
On Error GoTo 0
End With
End Sub
This code will loop through each row in the table, excluding the header, looking for vertically merged cells. Once it finds a block, it will assign the "Keep With Next" property to each row in the block, except for the last row.
very new to VBA but our clients want the all the data in 1,850 pages of Word Tables aligned right. I'm thinking this is pretty easy in VBA. I am trying to figure it out and I'm sure I could nail it on my own, but a deadline is forcing me to seek help. So I apologize in advance if I missed a published solution.
As an example they want this:
To be this:
So i've got:
Dim oTable As Table
Dim oRow As Row
For Each oTable In ActiveDocument.Tables
For Each oRow In oTable.Rows
But I don't know how to loop through just the body of the table. Also the top 4 rows (table title) is merged to one cell and the first column is still left aligned. Help, and the next rounds on me :)
Normally I'm not a huge fan of "please write code for me" but I've not done enough with VBA in Word and want to learn some myself.
This is going to get you most of the way there.
You do not currently provide enough information to allow me to guarantee the if statement is workable for the entire document but you should be able to go from here.
Sub alignTableElementsRight()
Dim oTable As Table
Dim oRow As Row
Dim i As Integer
Dim dataTable As Boolean
For Each oTable In ActiveDocument.Tables
'this will be set once you are in the "table" part and
'not headings
dataTable = False
For Each oRow In oTable.Rows
'you will need custom logic here to determine what your if statement
'is to properly execute on the right row, this is going to depend based on your table
'format, etc. This checks if a leftmost column heading is "65 to 66"
If (InStr(oRow.Cells(1).Range.Text, "65 to 66") > 0) Then
dataTable = True
End If
'if you are in the datatable, move all values to align right in each row following
If (dataTable = True) Then
For i = 2 To oRow.Cells.Count
oRow.Cells(i).Range.ParagraphFormat.Alignment = wdAlignParagraphRight
Next i
End If
Next oRow
Next oTable
End Sub
I have a macro that I'm using to remove all of the color in all of the tables in certain Word Documents. The colors being removed are there initially to indicate where someone should type.
Trust me, I'd rather use form fields or ActiveX text boxes, but this is not a situation where they will work as Word is being opened through a 3rd party application that invalidates these with a mail merge. Anyway, I want to skip over the first table. I have the code below set up to do it, then change the first cell of the first table back to a particular color.
Sub decolordocument()
'
' decolordocument Macro
'
'
Dim tbl As Table
For Each tbl In ActiveDocument.Tables
tbl.Shading.BackgroundPatternColor = wdColorWhite
Next
ActiveDocument.Tables(1).Cell(1, 1).Shading.BackgroundPatternColor = wdColorLightTurquoise
End Sub
This works fine for removing the color, but the color of that first cell of the first table isn't the same in all of them. I just want to skip the first table during the for each loop. I've tried an if statement (If tbl = ActiveDocument.Tables(1) Then...) but evidently this is not an allowed comparison as it doesn't recognize the Then statement. I've also tried doing this with a range, but couldn't quite get it right. Any thoughts would be appreciated.
Sub decolordocument()
'
' decolordocument Macro
'
'
Dim first as Boolean
Dim tbl As Table
first = true
For Each tbl In ActiveDocument.Tables
If first Then
first = false
Else
tbl.Shading.BackgroundPatternColor = wdColorWhite
End If
Next
'ActiveDocument.Tables(1).Cell(1, 1).Shading.BackgroundPatternColor = wdColorLightTurquoise
End Sub
if activedocument.Tables.Count >1 then
for x = 2 to activedocument.Tables.Count
activedocument.Tables(x).Shading.BackgroundPatternColor = wdColorWhite
next x
end if