View Single Post
  #9   Report Post  
Posted to microsoft.public.excel.programming
TotallyConfused TotallyConfused is offline
external usenet poster
 
Posts: 144
Default How to set PrintSetup?

Thank you Dave. It was the Zoom that was causing it to go to 6 pages. I
adjusted it to 90 and it gives me only 3 pages. Thank you so much. Very
much appreciate you and this forum.

"Dave Peterson" wrote:

I'm not sure why you're getting the extra 3 pages, though.

After you run the macro, take a look at that sheet to see if the print range is
what you expected--not too wide, not too tall.

TotallyConfused wrote:

Thank you Dave this worked. Below is the code. I tried to tweak it and it
didn't work, I copied back as was recorded and made the changes you
suggested. I tested it and it works fine where the final print prints three
form pages to one print page. But at the end I get 3 blank pages. How do I
fix this? Thank you in advance for all your help. It is very much
appreciated. Thank you.

Private Sub CommandButton6_Click()

Dim myPict As Picture
Dim PrintWks As Worksheet
Dim iCtr As Long
Dim CurPage As Long
Dim DestCell As Range

'set up that sheet one time
Set PrintWks = Workbooks.Add(1).Worksheets(1)

With PrintWks
.PageSetup.Orientation = xlPortrait
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With

ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.25)
.RightMargin = Application.InchesToPoints(0.25)
.TopMargin = Application.InchesToPoints(0.25)
.BottomMargin = Application.InchesToPoints(0.25)
.HeaderMargin = Application.InchesToPoints(0.25)
.FooterMargin = Application.InchesToPoints(0.25)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = True
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
.PrintErrors = xlPrintErrorsDisplayed
End With

'keep track of what page was active
CurPage = Me.MultiPage1.Value

'some sort of loop
For iCtr = 0 To Me.MultiPage1.Pages.Count - 1
Me.MultiPage1.Value = iCtr
Me.Repaint '<-- Added

'do the printing for each page
keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY, 0
keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY, 0
keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY + _
KEYEVENTF_KEYUP, 0
keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY + _
KEYEVENTF_KEYUP, 0
DoEvents

With PrintWks
Application.Wait Now + TimeValue("00:00:01")
.PasteSpecial Format:="Bitmap", Link:=False, _
DisplayAsIcon:=False

'the last one added
Set myPict = .Pictures(.Pictures.Count)
Set DestCell = .Range("a1").Offset(iCtr, 0)
End With

'instead of resizing the picture, I just resized
'a cell. You'll want to play with that to get the
'dimensions nice for your userform.
DestCell.RowHeight = 250
DestCell.ColumnWidth = 100

With DestCell
myPict.Top = .Top
myPict.Height = .Height
myPict.Left = .Left
myPict.Width = .Width
End With

Next iCtr

Me.Hide 'hide the userform
PrintWks.PrintOut preview:=True 'save a tree while testing!
Me.Show

'Uncomment when you're done testing.
'PrintWks.Parent.Close savechanges:=False

End With

End Sub

"Dave Peterson" wrote:

I don't know what requestorinfo is, but this doesn't look right to me:

RequestorInfo(RequestorInfo).Visible = False
maybe it should be:
RequestorInfo.Visible = False

Second record a macro when you change the margins for a worksheet in a test
workbook.

Then this portion:

With PrintWks
.PageSetup.Orientation = xlLandscape
.PageSetup.Zoom = False
.PageSetup.FitToPagesWide = 1
.PageSetup.FitToPagesTall = 1
End With

Will have to change.

Drop the .zoom and the .fittopages???? lines and replace them with your recorded
(but slightly tweaked) code.

If you have trouble, post back with the code you tried.

TotallyConfused wrote:

Thank you this works just fine. However, different users will be using this
form and will want to print the form. I would like to make it as easy as
possible. Right now the way the form comes up is very small for anyone to
read. I would like to the to print three pages in one portrait size sheet.
I am having trouble setting up the margins to be 0.25 for top, bottom, left
and right. Which would print to five pages. I tried several way to do this
and I am not being very successful.

When I exit the userform is fine and then it will ask me if I want to save
or not or cancel the Sheet1. If I have it I have not problems. If I click
on "No" I get the following run time error message of 438, "Object does not
support this property or method". When I click on debug it takes me to the
following code and the RequestorInfo line is highlighted in yellow:

Can you please help me with this? Thank you.

Private Sub CommandButton3_Click()

If MsgBox("Do you want to Exit?", vbOKCancel, "Exit or Cancel??") = vbOK Then
'whatever you want to do
Unload Me 'closes the form
ActiveWorkbook.Close 'closes the workbook
RequestorInfo(RequestorInfo).Visible = False
End If

End Sub

"TotallyConfused" wrote:

I need help please. How do I send a Userfrom to print all 5 pages of my form
to print in landscape and the form to fit on a 8.5 x 11 sheet of paper.
After a lot of research I have the following code. It prints my form but
only the page I am when I hit the print button. I want all pages to print.
And how can you force it to print the form in one page. Right now it prints
the screen on 4 pages with parts of the form on all pages. I would
appreciate very much any help you can provide. Thank you.



Private Sub CommandButton6_Click()

UserForm2.PrintForm
ActiveSheet.PageSetup.Orientation = xlLandscape
' keybd_event VK_SNAPSHOT, 0, 0, 0
DoEvents
keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY, 0
keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY, 0
keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY + _
KEYEVENTF_KEYUP, 0
keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY + _
KEYEVENTF_KEYUP, 0
DoEvents
Workbooks.Add
Application.Wait Now + TimeValue("00:00:01")
ActiveSheet.PasteSpecial Format:="Bitmap", Link:=False, _
DisplayAsIcon:=False
ActiveSheet.Range("A1").Select
'added to force landscape
ActiveSheet.PageSetup.Orientation = xlLandscape
ActiveSheet.PageSetup.FitToPagesWide = 1
ActiveSheet.PageSetup.FitToPagesTall = 1
ActiveWindow.SelectedSheets.PrintOut Copies:=1

ActiveWorkbook.Close False
End Sub

--

Dave Peterson
.


--

Dave Peterson
.