A
Alan
When calling the code found below I often get a runtime error # 4608
(Value out of range). I believe it has something to do with a
precision problem, but I do not understand why I am getting it, as all
the variables are Singles.
Also, when I set a cell width, it does not always change it to the
exact value I want.
The code is running in Excel but manipulating a Word document.
Thanks in Advance, Alan
Sub FixBDtableWidth()
Dim matchWidth As Single, currWidth As Single, delta As Single
Dim LastCellWidth As Single, Next2LastCellWidth As Single
With Word.ActiveDocument.Tables(2)
matchWidth = TotalRowWidth(2, 1)
Debug.Print "matchWidth = " & matchWidth
.Cell(2, 1).Width = 72
.Cell(2, 2).Width = 72
currWidth = TotalRowWidth(2, 2)
delta = currWidth - matchWidth
LastCellWidth = .Cell(2, 12).Width
If currWidth > matchWidth Then
If (LastCellWidth > delta) Then
.Cell(2, 12).Width = LastCellWidth - delta
Else
.Cell(2, 12).Width = 5
End If
End If
End With
End Sub
Function TotalRowWidth(TableNum As Integer, RowNum As Long) As Single
Dim aCell As Word.Cell
TotalRowWidth = 0
On Error GoTo SafeExit
With Word.ActiveDocument
For Each aCell In .Tables(TableNum).Rows(RowNum).Cells
TotalRowWidth = TotalRowWidth + aCell.Width
Next aCell
End With
Exit Function
SafeExit:
Set aCell = Nothing
TotalRowWidth = 0
End Function
(Value out of range). I believe it has something to do with a
precision problem, but I do not understand why I am getting it, as all
the variables are Singles.
Also, when I set a cell width, it does not always change it to the
exact value I want.
The code is running in Excel but manipulating a Word document.
Thanks in Advance, Alan
Sub FixBDtableWidth()
Dim matchWidth As Single, currWidth As Single, delta As Single
Dim LastCellWidth As Single, Next2LastCellWidth As Single
With Word.ActiveDocument.Tables(2)
matchWidth = TotalRowWidth(2, 1)
Debug.Print "matchWidth = " & matchWidth
.Cell(2, 1).Width = 72
.Cell(2, 2).Width = 72
currWidth = TotalRowWidth(2, 2)
delta = currWidth - matchWidth
LastCellWidth = .Cell(2, 12).Width
If currWidth > matchWidth Then
If (LastCellWidth > delta) Then
.Cell(2, 12).Width = LastCellWidth - delta
Else
.Cell(2, 12).Width = 5
End If
End If
End With
End Sub
Function TotalRowWidth(TableNum As Integer, RowNum As Long) As Single
Dim aCell As Word.Cell
TotalRowWidth = 0
On Error GoTo SafeExit
With Word.ActiveDocument
For Each aCell In .Tables(TableNum).Rows(RowNum).Cells
TotalRowWidth = TotalRowWidth + aCell.Width
Next aCell
End With
Exit Function
SafeExit:
Set aCell = Nothing
TotalRowWidth = 0
End Function