Hi all,
Using Excel 2010,
My snippet below is returning the correct range address $D:$M, but the wrong Columns.Count : 9 (Should be 10)
Any ideas why that may be?
thanks
W
With r3
If dWidthPivotTables < dMaxWidth Then
If IsError(Int((dMaxWidth - dWidthPivotTables) / 255)) Or Int((dMaxWidth - dWidthPivotTables) / 255) = 0 Then
'Only one column is needed, the width is less than 255
lColumnsPartialNeeded = 1
dColWidthPartial = dMaxWidth - dWidthPivotTables
Set r3 = .Resize(lRowsCurrent, lColumnsCurrent + lColumnsPartialNeeded)
Debug.Print r3.Address
Debug.Print .Columns.Count
.Columns(.Columns.Count).ColumnWidth = dColWidthPartial
Debug.Print dColWidthPartial
Full:
Option Explicit
Sub Foo()
'
'Assumptions:
'1.) Calling sub tests if worksheet has at least one Pivot Table
'
Dim ws As Worksheet
Dim r As Range
Dim r2 As Range
Dim r3 As Range
Dim i As Long
Dim lColumnsWholeNeeded As Long
Dim lColumnsPartialNeeded As Long
Dim lColTotalDifference As Long
Dim dColWidthPartial As Double
Dim lRowsCurrent As Long
Dim lColumnsCurrent As Long
Dim lFirstRow As Long
Dim lColumn As Long
Dim dWidthPivotTables As Double
Dim dMaxWidth As Double
Set ws = ThisWorkbook.Worksheets("39")
dMaxWidth = 478.58
With ws
'Set intitial print range for all pivot tables on worksheet
If .PivotTables.Count > 1 Then
If .PivotTables(1).TableRange1.Address < .PivotTables(2).TableRange1.Address Then
Set r = .PivotTables(1).TableRange1
Set r = r.Offset(2, 0).Resize(r.Rows.Count - 2)
Set r2 = .PivotTables(2).TableRange2
Else
Set r = .PivotTables(2).TableRange1
Set r = r.Offset(2, 0).Resize(r.Rows.Count - 2)
Set r2 = .PivotTables(1).TableRange1
End If
Set r3 = Range(r, r2)
Else 'PivotTable Count = 1
Set r3 = .PivotTables(1).TableRange1
Set r3 = r3.Offset(2, 0).Resize(r.Rows.Count - 2)
End If
End With
'Current settings range r3
lRowsCurrent = r3.Rows.Count
lColumnsCurrent = r3.Columns.Count
'Find the intial width of Pivot Tables and seperator columns on the worksheet
dWidthPivotTables = TotalWidth(ws)
'If width less than MaxWidth, then add additional columns to print range until width = MaxWidth
With r3
If dWidthPivotTables < dMaxWidth Then
If IsError(Int((dMaxWidth - dWidthPivotTables) / 255)) Or Int((dMaxWidth - dWidthPivotTables) / 255) = 0 Then
'Only one column is needed, the width is less than 255
lColumnsPartialNeeded = 1
dColWidthPartial = dMaxWidth - dWidthPivotTables
Set r3 = .Resize(lRowsCurrent, lColumnsCurrent + lColumnsPartialNeeded)
Debug.Print r3.Address
Debug.Print .Columns.Count
.Columns(.Columns.Count).ColumnWidth = dColWidthPartial
Debug.Print dColWidthPartial
Else
'Multiple columns are needed
lColumnsWholeNeeded = Int((dMaxWidth - dWidthPivotTables) / 255)
lColumnsPartialNeeded = 1
Set r3 = .Resize(lRowsCurrent, lColumnsCurrent + lColumnsWholeNeeded + lColumnsPartialNeeded)
'New columns added (new count - original count)
lColTotalDifference = .Columns.Count - lColumnsCurrent
End If
'Of the new columns, all but the last are max width 255 char's
For i = .Columns.Count To (lColumnsCurrent + 1) Step -1
If i = .Columns.Count Then
.Columns(i).ColumnWidth = dMaxWidth - (dWidthPivotTables + (255 * (lColTotalDifference - 1)))
Else
.Columns(i).ColumnWidth = 255
End If
Next i
End If
End With
'Set the print area
With ws
.PageSetup.PrintArea = r3.Address
.DisplayPageBreaks = True
.[D13] = " "
.[D14] = " "
End With
'Tidy up
'Destroy objects
Set r = Nothing
Set r2 = Nothing
Set r3 = Nothing
End Sub
Bookmarks