Hi Paul,

Am Tue, 6 Jan 2015 10:46:07 -0800 (PST) schrieb Paul Doucette:

Well... The row heights and column widths are not standard, and when I tried running Subprintarea2 it hung up here and gave me runttime error 438:
boxBottom = .TextBox21.Top + .TextBox21.Height

if it is a textbox from the shapes then try:

Sub PrintArea2()
Dim boxBottom As Double, boxRight As Double
Dim LRow As Long, LCol As Long
Dim i As Long
Dim LCell As Range

With ActiveSheet
'Modify textbox name
boxBottom = .Shapes("Textfeld 1").Top + .Shapes("Textfeld 1").Height
boxRight = .Shapes("Textfeld 1").Left + .Shapes("Textfeld 1").Width
'Checking for last row. Modify i
For i = 48 To 85
If .Range(.Cells(1, 1), .Cells(i, 1)).Height boxBottom Then
LRow = i
Exit For
End If
Next
'Checking for last column. Modify i
For i = 30 To 50
If .Range(.Cells(1, 1), .Cells(1, i)).Width boxRight Then
LCol = i
Exit For
End If
Next

Set LCell = .Cells(LRow, LCol)
.PageSetup.PrintArea = .Range(.Cells(1, 1), LCell).Address
End With
End Sub


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional