View Single Post
  #6   Report Post  
Posted to microsoft.public.excel.programming
GS[_2_] GS[_2_] is offline
external usenet poster
 
Posts: 3,514
Default Disable 'Save/Save As', Enable 'Save as PDF'

When I use the "Cancel=True" it will not allow me to save the code
that I've put in...I got around this by e-mailing it to myself and
pasting the document.

But when "Cancel=True" it does not allow my to save or save as, which
is good. But it also does not allow me to save as a PDF, which is
the function I need.

Any ideas?


Clearly you *did not* go through the steps manually with the macro
recorder (as instructed) to get the code you need. This begs me to ask
*why are you asking for code now???*

Otherwise...

In the *ThisWorkbook* component:

Option Explicit

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As
Boolean)
Call SaveAs_PDF: Cancel = True
End Sub


In a *standard module*:

Option Explicit

Sub SaveAs_PDF()
Dim sFile$, lPos&, vSettings
Const lTypePDF& = 0: Const lTypeXPS& = 1

sFile = ThisWorkbook.FullName: lPos = InStrRev(sFile, ".")
sFile = IIf(lPos 0, Left(sFile, lPos + 1), sFile) & ".pdf"
sFile = Application.GetSaveAsFilename(sFile, "PDF Files (*.pdf),
*.pdf")
If sFile = "False" Then Exit Sub '//user cancels

'Refer to Test_SaveAs_FixedFormat for further explanations
'on using the SaveAs_FixedFormat procedure.
vSettings = Split("0,0,0,0", ",") '//edit to suit
SaveAs_FixedFormat FileType:=lTypePDF, Filename:=sFile,
Settings:=vSettings
End Sub

Sub Test_SaveAs_FixedFormat()
' Shows the various ways to use the SaveAs_FixedFormat routine.
' How the values passed to it are assembled is up to you!
' This example's focus is on how to prep the args only.

Dim sFile$, rng, vSettings
Const lTypePDF& = 0: Const lTypeXPS& = 1

'ExportAsFixedFormat accepts the following ArgsIn:
' Quality: Standard=0, Minimum=1 (file size)
' IncludeDocProperties: False=0, True=1
' IgnorePrintAreas: False=0, True=1
' OpenAfterPublish: False=0, True=1
'We pass our preferences for these to SaveAs_FixedFormat as a variant
array.
vSettings = Split("0,0,0,0", ",") '//edit to suit


'[Construct the Filename according to output path]
'NOTE: Do not include the filename extension
'when using the ExportAsFixedFormat feature.

'If output to ActiveWorkbook.Path, use
'.....................................
sFile = Split(ActiveWorkbook.FullName, ".")(0)
'Edit workbook ref to suit

'If output to a different path, use
'..................................
'Build sFile in logical steps
sFile = "C:\Users\Garry\Documents\VBA_Stuff\" '//path
'Append the filename as per your requirements
sFile = sFile & Split(ActiveWorkbook.Name, ".")(0)
'Edit workbook ref to suit


'[Specifying a range of sheets, or a selected sheets grouping]
'................................................. ............
'To Export StartWith/EndWith range of sheets, use
rng = Split("1,2", ",") '//From=rng(0),To=rng(1)
'OR
'To Export a random grouping as selected while pressing 'Ctrl', use
rng = Split("1", ",") '//makes LBound=UBound


'[Exporting scenarios]
'To Export 1 file per selected sheet (random grouping)
SaveAs_FixedFormat FileType:=lTypeXPS, Filename:=sFile,
Settings:=vSettings
'OR
SaveAs_FixedFormat FileType:=lTypePDF, Filename:=sFile,
Settings:=vSettings


'To Export a From/To range of sheets to 1 file
rng = Split("1,2", ",")
SaveAs_FixedFormat FileType:=lTypeXPS, Filename:=sFile, _
Settings:=vSettings, IsGroup:=True, FromToRng:=rng
'OR
SaveAs_FixedFormat FileType:=lTypePDF, Filename:=sFile, _
Settings:=vSettings, IsGroup:=True, FromToRng:=rng


'To Export selected sheets to 1 file (random grouping)
rng = Split("1", ",")
SaveAs_FixedFormat FileType:=lTypeXPS, Filename:=sFile, _
Settings:=vSettings, IsGroup:=True, FromToRng:=rng
'OR
SaveAs_FixedFormat FileType:=lTypePDF, Filename:=sFile, _
Settings:=vSettings, IsGroup:=True, FromToRng:=rng


'To Export all sheets to 1 file
SaveAs_FixedFormat FileType:=lTypeXPS, Filename:=sFile, _
Settings:=vSettings, IsGroup:=True
'OR
SaveAs_FixedFormat FileType:=lTypePDF, Filename:=sFile, _
Settings:=vSettings, IsGroup:=True
End Sub 'Test_SaveAs_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") '//optional

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