Printing Userform Part2?

T

TotallyConfused

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
 
D

Dave Peterson

You only need to save the file once. So you could remove the "on error resume
next" line.

I think I would ask first...

Near the top of your code--along with the other Dim statements.

Dim Resp as long
dim PicFileName as Variant

Then replace this:

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

with


Dim Resp As Long
Dim PicFileName As Variant

.....lots of code here

Resp = MsgBox(Prompt:="Wanna save the pictures?", Buttons:=vbYesNo)
If Resp = vbYes Then
PicFileName = Application.GetSaveAsFilename _
(filefilter:="Excel files, *.xls")
If PicFileName = False Then
'user canceled, do nothing
Else
'overwrite any existing file with the same name
Application.DisplayAlerts = False
On Error Resume Next
PrintWks.Parent.SaveAs Filename:=PicFileName, _
FileFormat:=xlWorkbookNormal
If Err.Number <> 0 Then
MsgBox "Save Failed" & vbLf & Err.Number & vbLf &
Err.Description
Err.Clear
Else
MsgBox "Saved to: " & PrintWks.Parent.FullName
End If
On Error GoTo 0
Application.DisplayAlerts = True
End If
End If

'close without saving
'it was just saved or they said they didn't want to
PrintWks.Parent.Close savechanges:=False

Unload Me 'closes the form

========
I don't think I'd put the final .close line in the code. I'd let the user
decide when they wanted to close the workbook.

If you really wanted to close the workbook, then add it to the macro that shows
the userform:

userform1.show
thisworkbook.close 'savechanges??????
'or
activeworkbook.close 'savechanges????

ThisWorkbook is the workbook that owns the code--not always the the
activeworkbook.
 
T

TotallyConfused

Dave, I made the changes, however when I save or not save the pics I get the
following message Run-time error-2147221080 (800401a8)': Method "Parent of
object" _ Worksheet failed End or Debug. When I click on Debug it takes me
to the code line "PrintWks.Parent.Close.savechanges:=False.

Again, my file got corrupted and I almost had a heart attack!! Why does it
do this or it is have to do when I have nother Excel file open or will open?
Is there something that can be done?

I do not need to save the "pics". We only need to save the Excel sheet with
the pics how do make sure which code to elimiate? Thank you again.


Private Sub CommandButton6_Click()

Dim myPict As Picture
Dim PrintWks As Worksheet
Dim iCtr As Long
Dim CurPage As Long
Dim DestCell As Range
Dim Resp As Long
Dim PicFileName As Variant

'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

Resp = MsgBox(Prompt:="Wanna save the pictures?", Buttons:=vbYesNo)
If Resp = vbYes Then
PicFileName = Application.GetSaveAsFilename _
(filefilter:="Excel files, *.xls")
If PicFileName = False Then
'user canceled, do nothing
Else
'overwrite any existing file with the same name
Application.DisplayAlerts = False
On Error Resume Next
PrintWks.Parent.SaveAs Filename:=PicFileName, _
FileFormat:=xlWorkbookNormal
If Err.Number <> 0 Then
MsgBox "Save Failed" & vbLf & Err.Number & vbLf &
Err.Description
Err.Clear
Else
MsgBox "Saved to: " & PrintWks.Parent.FullName
End If
On Error GoTo 0
Application.DisplayAlerts = True
End If
End If

'close without saving
'it was just saved or they said they didn't want to
PrintWks.Parent.Close savechanges:=False

Unload Me 'closes the form


End With

End Sub
 
D

Dave Peterson

I don't have a guess why your workbooks are getting corrupted. And I don't have
a guess why that doesn't work.

(The line in the code is correct. The line in your message has a typo.)

Which file is being corrupted? The picture file or the workbook with the code
or the active workbook?
 
D

Dave Peterson

I still don't have a guess.

If you comment the code that does the saving and save it manually, do you have
the same trouble?

(You answer won't help me, but maybe it'll help someone else.)
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Need Help with Print Out of Userform 1
Multipage?? 1
Printing userform in landscape on one page only 2
How to set PrintSetup? 8
Resizing and Printing a UserForm 3
Is there an easy Copy/Paste of a Userform ? (Entire Userform Including tx & cbx's) 1
Getting unnecessary 2nd Page 3
Word macro that can call cells out of Excel for a find and replace 0

Top