Need Help with Print Out of Userform

[TotallyConfused]

I have the following for a Userform. I initially had the Userform print
preview the pages of the multipage form. However this is not working and I
have been asked to have the following changes. When Clicking on the Print
Button (Commandbutton6) go to File Print. To let user print only pages
desired. Then have messge box say "form is printing" When done printing,
have message box say "form printing completed". After print completed, go
back to Userform. If user wants to save worksheet with pics of userform,
then allow to save and return to userform. If user does not want to save
worksheet with pics of userform, then allow user to return to userform to
exit out of userform.

I tried several times to accomplish this to only mess it up over and over.
I would really appreciate someone please helping me accomplish this. 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
With PrintWks.PageSetup
.Orientation = xlPortrait
.PrintTitleRows = ""
.PrintTitleColumns = ""

.PrintArea = ""

.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0)
.RightMargin = Application.InchesToPoints(0)
.TopMargin = Application.InchesToPoints(0)
.BottomMargin = Application.InchesToPoints(0)
.HeaderMargin = Application.InchesToPoints(0)
.FooterMargin = Application.InchesToPoints(0)
.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 = 90
.PrintErrors = xlPrintErrorsDisplayed
End With

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

'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


DestCell.RowHeight = 285
DestCell.ColumnWidth = 105

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:=False
Me.Show


On Error Resume Next
PrintWks.Parent.Close savechanges:=True
PrintWks.Parent.Close savechanges:=False
Unload Me 'closes the form
ActiveWorkbook.Close 'closes the workbook


End With

End Sub

 

[Simon Lloyd]

You may have to "repaint" the userform to accomplish this

I have the following for a Userform. I initially had the Userform prin
preview the pages of the multipage form. However this is not workin
and
have been asked to have the following changes. When Clicking on th
Prin
Button (Commandbutton6) go to File Print. To let user print only page
desired. Then have messge box say "form is printing" When don
printing
have message box say "form printing completed". After print completed
g
back to Userform. If user wants to save worksheet with pics o
userform
then allow to save and return to userform. If user does not want t
sav
worksheet with pics of userform, then allow user to return to userfor
t
exit out of userform

I tried several times to accomplish this to only mess it up over an
over
I would really appreciate someone please helping me accomplish this
Than
you

Code
-------------------
Private Sub CommandButton6_Click(

Dim myPict As Pictur
Dim PrintWks As Workshee
Dim iCtr As Lon
Dim CurPage As Lon
Dim DestCell As Rang

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

With PrintWk
With PrintWks.PageSetu
.Orientation = xlPortrai
.PrintTitleRows = "
.PrintTitleColumns = "

.PrintArea = "

.LeftHeader = "
.CenterHeader = "
.RightHeader = "
.LeftFooter = "
.CenterFooter = "
.RightFooter = "
.LeftMargin = Application.InchesToPoints(0
.RightMargin = Application.InchesToPoints(0
.TopMargin = Application.InchesToPoints(0
.BottomMargin = Application.InchesToPoints(0
.HeaderMargin = Application.InchesToPoints(0
.FooterMargin = Application.InchesToPoints(0
.PrintHeadings = Fals
.PrintGridlines = Fals
.PrintComments = xlPrintNoComment
'.PrintQuality = 60
.CenterHorizontally = Tru
.CenterVertically = Fals
.Orientation = xlPortrai
.Draft = Fals
.PaperSize = xlPaperLette
.FirstPageNumber = xlAutomati
.Order = xlDownThenOve
.BlackAndWhite = Fals
.Zoom = 9
.PrintErrors = xlPrintErrorsDisplaye
End Wit

'keep track of what page was activ
CurPage = Me.MultiPage1.Valu

'loo
For iCtr = 0 To Me.MultiPage1.Pages.Count -
Me.MultiPage1.Value = iCt
Me.Repaint '<-- Adde

'do the printing for each pag
keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY,
keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY,
keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY +
KEYEVENTF_KEYUP,
keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY +
KEYEVENTF_KEYUP,
DoEvent

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

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


DestCell.RowHeight = 28
DestCell.ColumnWidth = 10

With DestCel
myPict.Top = .To
myPict.Height = .Heigh
myPict.Left = .Lef
myPict.Width = .Widt
End Wit

Next iCt

Me.Hide 'hide the userfor
PrintWks.PrintOut preview:=Fals
Me.Sho


On Error Resume Nex
PrintWks.Parent.Close savechanges:=Tru
PrintWks.Parent.Close savechanges:=Fals
Unload Me 'closes the for
ActiveWorkbook.Close 'closes the workboo


End Wit

End Su

-------------------

--
Simon Lloy

Regards
Simon Lloy
'Microsoft Office Help' (http://www.thecodecage.com