Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As
Boolean)
MsgBox "Saving this workbook has been disabled."
Cancel = NoSave
End Sub
When I hit save, the message box appears, but after I hit 'Ok' the
save
as or save as PDF box appears. I only want users to be able to save
as
a PDF. Any ideas on a code?
Not sure what value is held in 'NoSave' but isn't how we normally code
'Cancel' because it's just not as clear as 'Cancel=True'!
As I already said, just go through the steps with the macro recorder
turned on to generate code for the process. Otherwise, I use either of
2 approaches; PrintTo_FixedFormat or SaveAs_FixedFormat depending on
Excel version (The latter doesn't work in versions earlier than
XL2007). Code for these follows...
Sub PrintTo_FixedFormat(FileType&, Filename$, _
Optional NumCopies& = 1, Optional FromToRng, _
Optional IsGroup As Boolean = False, _
Optional StampIt As Boolean = True)
' Prints the following choices via XPS Document Writer OR PDF printer,
' as specified by 'FileType':
' Selected sheets, 1 file per sheet;
' Or a specified From/To range of sheets to 1 file,
' Or selected sheets (random grouping) to 1 file;
' Or an entire workbook to 1 file.
'
' ArgsIn:
' FileType& lTypePDF=0; lTypeXPS=1
' Filename Contains "<path\<wkbName"
' NumCopies !
' IsGroup !
'
Dim Wks As Worksheet, sExt$, sFile$, sStamp$
Dim sPrinter$, sDfltPrn$
Const sPrnXPS$ = "Microsoft XPS Document Writer on NE00:"
Const sPrnPDF$ = "deskPDF on DDM:"
'To quickly find the port your 'FileType' printer uses,
' - change the printer in the Print dialog and close without
printing;
' - in the VBE Immediate Window type the following, then press
'Enter';
' ?activeprinter
' - reset the printer in the Print dialog to your default!
'Initialize essential vars
sDfltPrn = Application.ActivePrinter '//reset when done
sPrinter = IIf(FileType = 0, sPrnPDF, sPrnXPS)
sExt = IIf(FileType = 0, ".pdf", ".xps")
sStamp = "_" & Format(Now(), "dd-mm-yyyy_hh-mm_AMPM")
sStamp = "_" & Format(Now(), "mmm-yyyy")
If Not IsGroup Then '//1 file per sheet
For Each Wks In ActiveWindow.SelectedSheets
sFile = Filename & "_" & Wks.name & IIf(StampIt, sStamp & sExt,
sExt)
sFile = Filename & IIf(StampIt, sStamp & sExt, sExt)
Wks.PrintOut ActivePrinter:=sPrinter, Copies:=NumCopies, _
PrintToFile:=True, PrToFileName:=sFile
Next 'wks
Else
sFile = Filename & IIf(StampIt, sStamp & sExt, sExt)
If Not IsMissing(FromToRng) Then '//it's a range
If Not LBound(FromToRng) = UBound(FromToRng) Then
ActiveWorkbook.PrintOut From:=CLng(FromToRng(0)),
To:=CLng(FromToRng(1)), _
ActivePrinter:=sPrinter, Copies:=NumCopies,
PrintToFile:=True, PrToFileName:=sFile
Else '//it's a random grouping
ActiveWindow.SelectedSheets.PrintOut ActivePrinter:=sPrinter, _
Copies:=NumCopies, PrintToFile:=True, PrToFileName:=sFile
End If 'Not LBound(FromToRng) = UBound(FromToRng)
Else
ActiveWorkbook.PrintOut ActivePrinter:=sPrinter,
Copies:=NumCopies, _
PrintToFile:=True, PrToFileName:=sFile
End If 'Not IsMissing(FromToRng)
End If 'Not IsGroup
Application.ActivePrinter = sDfltPrn
End Sub 'PrintTo_FixedFormat
Sub SaveAs_FixedFormat(FileType&, Filename$, _
Settings, Optional FromToRng, _
Optional IsGroup As Boolean = False, _
Optional StampIt As Boolean = True)
' Saves the following via ExportAsFixedFormat:
' Selected sheets, 1 file per sheet;
' Or a specified From/To group of sheets to 1 file,
' Or selected sheets (random grouping) to 1 file;
' Or an entire workbook to 1 file.
'
' ArgsIn:
' FileType& xlTypePDF (0) or xlTypeXSP (1)
' Filename$ Contains "<path\<wkbName" to which each wks.Name is
appended
' Settings Array containing the settings for the export params
' IsGroup !
'
Dim Wks As Worksheet, sExt$, sFile$, sStamp$
If Application.VERSION < 12 Then Exit Sub
sExt = IIf(FileType = 0, ".pdf", ".xps") '//always
sStamp = "_" & Format(Now(), "_dd-mm-yyyy_hh-mm_AMPM") '//always
sStamp = "_" & Format(Now(), "mmm-yyyy")
If Not IsGroup Then '//1 file per sheet
For Each Wks In ActiveWindow.SelectedSheets
sFile = Filename & "_" & Wks.name & IIf(StampIt, sStamp & sExt,
sExt)
sFile = Filename & IIf(StampIt, sStamp & sExt, sExt)
Wks.ExportAsFixedFormat Type:=FileType, Filename:=sFile, _
Quality:=Settings(0), IncludeDocProperties:=Settings(1), _
IgnorePrintAreas:=Settings(2), OpenAfterPublish:=Settings(3)
Next 'wks
Else '//multiple sheets per file
sFile = Filename & IIf(StampIt, sStamp & sExt, sExt)
If Not IsMissing(FromToRng) Then '//it's a group
If Not LBound(FromToRng) = UBound(FromToRng) Then '//it's From/To
ActiveWorkbook.ExportAsFixedFormat Type:=FileType,
Filename:=sFile, _
Quality:=Settings(0), IncludeDocProperties:=Settings(1), _
IgnorePrintAreas:=Settings(2), OpenAfterPublish:=Settings(3), _
From:=FromToRng(0), To:=FromToRng(1)
Else '//it's selected sheets (random grouping)
'ExportAsFixedFormat only works with workbooks/worksheets,
'so copy selected sheets to a new (temp) workbook,
'export it, then discard it.
Application.ScreenUpdating = False '//hide activity
ActiveWindow.SelectedSheets.Copy
With ActiveWorkbook
.ExportAsFixedFormat Type:=FileType, Filename:=sFile, _
Quality:=Settings(0), IncludeDocProperties:=Settings(1), _
IgnorePrintAreas:=Settings(2),
OpenAfterPublish:=Settings(3)
.Close SaveChanges:=False
End With 'ActiveWorkbook
Application.ScreenUpdating = True
End If 'Not LBound(FromToRng) = UBound(FromToRng)
Else '//all sheets
ActiveWorkbook.ExportAsFixedFormat Type:=FileType,
Filename:=sFile, _
Quality:=Settings(0), IncludeDocProperties:=Settings(1), _
IgnorePrintAreas:=Settings(2), OpenAfterPublish:=Settings(3)
End If 'Not IsMissing(FromToRng)
End If 'Not IsGroup
End Sub 'SaveAs_FixedFormat
--
Garry
Free usenet access at
http://www.eternal-september.org
Classic
VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.
vb.general.discussion