Print Area to include text box

  • Thread starter Thread starter Paul Doucette
  • Start date Start date
P

Paul Doucette

How can I set a print area on Sheet 1 from A1 (upper left) to the lower right corner of a text box regardless of where the text box is located?
Thanks!
 
Hi Paul,

Am Tue, 6 Jan 2015 05:51:45 -0800 (PST) schrieb Paul Doucette:
How can I set a print area on Sheet 1 from A1 (upper left) to the lower right corner of a text box regardless of where the text box is located?
Click to expand...

the height of your textbox is 3 rows, the width is 3 columns.
Then try (modify the textbox name):

Sub PrintArea()
Dim LRow As Long, LCol As Long
Dim LCell As Range

With ActiveSheet
LRow = .Shapes("textbox21").TopLeftCell.Row + 3
LCol = .Shapes("textbox21").TopLeftCell.Column + 3
Set LCell = .Cells(LRow, LCol)
.PageSetup.PrintArea = .Range(.Cells(1, 1), LCell).Address
End With
End Sub


Regards
Claus B.
 
How can I set a print area on Sheet 1 from A1 (upper left) to the lower right corner of a text box regardless of where the text box is located?
Thanks!
Click to expand...

Thank you for that.
My current print area is A1 to AG50. The text box sits on A17 to AG50. And it prints fine. However, sometimes the text box gets resized to a17 to AK75 or beyond, so I need the print area to increase so that part of the text box does not get cut off.
Many thanks, Paul
 
Hi Paul,

Am Tue, 6 Jan 2015 07:45:06 -0800 (PST) schrieb Paul Doucette:
My current print area is A1 to AG50. The text box sits on A17 to AG50. And it prints fine. However, sometimes the text box gets resized to a17 to AK75 or beyond, so I need the print area to increase so that part of the text box does not get cut off.
Click to expand...

if your columns have standard width and the rows standard height you can
use:

Sub PrintArea()
Dim LRow As Long, LCol As Long
Dim LCell As Range

With ActiveSheet
LRow = .Shapes("textbox21").TopLeftCell.Row + _
.TextBox21.Height / 15
LCol = .Shapes("textbox21").TopLeftCell.Column + _
.TextBox21.Width / 60
Set LCell = .Cells(LRow, LCol)
.PageSetup.PrintArea = .Range(.Cells(1, 1), LCell).Address
End With
End Sub


Regards
Claus B.
 
Hi again,

Am Tue, 6 Jan 2015 17:11:32 +0100 schrieb Claus Busch:
if your columns have standard width and the rows standard height you can
use:
Click to expand...

I don't know if standard width or standard height is equal in all
language versions. If not you have to modify the division.


Regards
Claus B.
 
Hi Paul,

Am Tue, 6 Jan 2015 07:45:06 -0800 (PST) schrieb Paul Doucette:
My current print area is A1 to AG50. The text box sits on A17 to AG50. And it prints fine. However, sometimes the text box gets resized to a17 to AK75 or beyond, so I need the print area to increase so that part of the text box does not get cut off.
Click to expand...

or 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
boxBottom = .TextBox21.Top + .TextBox21.Height
boxRight = .TextBox21.Left + .TextBox21.Width
'Checking for last row. Modify i
For i = 48 To 75
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 = 32 To 40
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.
 
How can I set a print area on Sheet 1 from A1 (upper left) to the lower right corner of a text box regardless of where the text box is located?
Thanks!
Click to expand...

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
 
Hi Paul,

Am Tue, 6 Jan 2015 10:46:07 -0800 (PST) schrieb Paul Doucette:
when I tried running Subprintarea2 it hung up here and gave me runttime error 438:
boxBottom = .TextBox21.Top + .TextBox21.Height
Click to expand...

then your textboxes are no ActiveX-Elements.
What textboxes do you use?


Regards
Claus B.
 
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
Click to expand...

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.
 
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
Click to expand...

Why are you needing/using a textbox? Is there some reason the contents
of the textbox can't fit a merged area or occupy cols/rows within the
area covered by the textbox?

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion
 
How can I set a print area on Sheet 1 from A1 (upper left) to the lower right corner of a text box regardless of where the text box is located?
Thanks!
Click to expand...

THAT WORKED!!!!!!! You Rock! Thanks!!!! :-)
 
Back
Top