I would appreciate it if you could pls review this code. This is regarding
previous post on print set up. I was testing and in trying to save sheet I
got error message and the form was unable to open file was corrupted.
Luckily I had a copy and started over with setting up printing. I added at
the end the following because I wanted to give the user the option to save
the form on worksheet with bitmaps instead of printing. They can save to
their share for reference. Not sure if this is correct. I tested it and it
seems fine. I would also like to instead of when printing and seeing the
pages scroll could we just have a timer and when finished printing have a
message box say done printing? Can you please help with this? Thank you
again for all your help.

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

I just want to make sure I do not loose this again. Is there a way to not
have the pages


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

'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 = 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:=True 'save a tree while testing!
Me.Show

'Uncomment when you're done testing.
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