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