PDA

View Full Version : Saving Worksheet as PDF



PaulM
06-19-2015, 03:23 PM
Hello all,

I know this is a simple issue, but I've just stared using VBA for Excel 2011 (for Mac) and am pretty clueless. I have done some programming before so I've been trying to piece together what I've been able to find from the internet. I've given up though. Now I would like to ask all of you lovely people! I got most of this code from online and understand the basics of how it works, but am having trouble editing it to do what I want.

About the Program:
This program is designed to let the user select the section they would like to e-mail and e-mail it as a PDF. The only issue I am having is with saving the selection as a PDF. What the program is doing right now is copying the selection, creating a new workbook and pasting the selection (values and formats) and e-mailing that.

The issue:
It's e-mailing using .SaveAs. I know saving files as a PDF works much better with .ExportAsFixedFormat, but I can't get it to work properly. I keep getting the error message: "Compile Error: Expected =" I have no idea what this means. Maybe there's nothing that I'm setting it to?

Please explain things in a way that I can understand. I'm the only one here at my job with any knowledge of programing and they want me to do everything for them. I need to be able to understand this since I'm sure it's only going to get more complicated from here.

Thank you so much for any help you can give!

I'm trying to add the code but am running into errors that won't let me post them (too many URLs and forbidden words). As far as I know, it doesn't have any of either, but I'll keep trying to list the code on here somehow.

PaulM
06-19-2015, 03:32 PM
Ahah! Found out the problem was my code included e-mails. The more you know!

Important Parts of the Code:


Sub Mail_Selection()
'For Excel 2011 for the Mac and Apple Mail
Dim Source As Range
Dim Destwb As Workbook
Dim wb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim FileFormatNum As Long


If Val(Application.Version) < 14 Then Exit Sub


Set Source = Nothing
On Error Resume Next
Set Source = Selection.SpecialCells(xlCellTypeVisible)
On Error GoTo 0


If Source Is Nothing Then
MsgBox "The source is not a range or the sheet is protected, " & _
"please correct and try again.", vbOKOnly
Exit Sub
End If


If ActiveWindow.SelectedSheets.Count > 1 Or _
Selection.Cells.Count = 1 Or _
Selection.Areas.Count > 1 Then
MsgBox "An Error occurred :" & vbNewLine & vbNewLine & _
"You have more than one sheet selected." & vbNewLine & _
"You only selected one cell." & vbNewLine & _
"You selected more than one area." & vbNewLine & vbNewLine & _
"Please correct and try again.", vbOKOnly
Exit Sub
End If


With Application
.ScreenUpdating = False
.EnableEvents = False
End With


Set wb = ActiveWorkbook
Set Destwb = Workbooks.Add(xlWBATWorksheet)


Source.Copy
With Destwb.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial Paste:=xlPasteValues
.Cells(1).PasteSpecial Paste:=xlPasteFormats
.Cells(1).Select
Application.CutCopyMode = False
End With

'pdf extension isn't working. Will try to fix later.
'FileExtStr = ".pdf": FileFormatNum = 17

'Save format and extension
FileExtStr = ".xlsx": FileFormatNum = 52


'Or if you want it in xls format, use:
'FileExtStr = ".xls": FileFormatNum = 57


'Save the new workbook, mail it, and delete it.
'If you want to change the file name then change only TempFileName
TempFilePath = MacScript("return (path to documents folder) as string")
TempFileName = Left(wb.Name, InStr(1, wb.Name, ".", 1) - 1) & " " & Format(Now, "dd-mmm-yy")



'With Destwb.Sheets(1)
' .ExportAsFixedFormat(Type:=xlTypePDF , Filename:= TempFilePath & TempFileName & ".pdf", Quality:= xlQualityStandard)
'
'This is what I can't get to work properly ^^



With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
MailFromMacWithMail bodycontent:="Aquí estan todas las reservas que tenemos para usted." & Chr(13) & Chr(13), _
mailsubject:="Reservas de - ADD COMPANY NAME HERE (2015)", _
toaddress:="", _
ccaddress:="", _
bccaddress:="", _
attachment:=.FullName, _
displaymail:=True
.Close SaveChanges:=False
End With


KillFileOnMac TempFilePath & TempFileName & FileExtStr


With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub


All the Code:


Function MailFromMacwithOutlook(bodycontent As String, mailsubject As String, _
toaddress As String, ccaddress As String, bccaddress As String, _
attachment As String, displaymail As Boolean)


Dim scriptToRun As String


scriptToRun = scriptToRun & "tell application " & _
Chr(34) & "Microsoft Outlook" & Chr(34) & Chr(13)


scriptToRun = scriptToRun & _
"set NewMail to make new outgoing message with properties" & _
"{content:""" & bodycontent & """, subject:""" & mailsubject & """}" & Chr(13)


If toaddress <> "" Then scriptToRun = scriptToRun & _
"make new to recipient at NewMail with properties" & _
"{email address:{address:""" & toaddress & """}}" & Chr(13)


If ccaddress <> "" Then scriptToRun = scriptToRun & _
"make new cc recipient at NewMail with properties" & _
"{email address:{address:""" & ccaddress & """}}" & Chr(13)


If bccaddress <> "" Then scriptToRun = scriptToRun & _
"make new bcc recipient at NewMail with properties" & _
"{email address:{address:""" & bccaddress & """}}" & Chr(13)


If attachment <> "" Then
scriptToRun = scriptToRun & "make new attachment at NewMail with properties" & _
"{file:""" & attachment & """ as alias}" & Chr(13)
End If


If displaymail = False Then
scriptToRun = scriptToRun & "send NewMail" & Chr(13)
Else
scriptToRun = scriptToRun & "open NewMail" & Chr(13)
End If
scriptToRun = scriptToRun & "end tell" & Chr(13)


If Len(toaddress) + Len(ccaddress) + Len(bccaddress) = 0 Or mailsubject = "" Then
MsgBox "There is no To, CC or BCC address or Subject for this mail"
Exit Function
Else
On Error Resume Next
MacScript (scriptToRun)
On Error GoTo 0
End If
End Function


Function MailFromMacWithMail(bodycontent As String, mailsubject As String, _
toaddress As String, ccaddress As String, bccaddress As String, _
attachment As String, displaymail As Boolean)






Dim scriptToRun As String


scriptToRun = scriptToRun & "tell application " & _
Chr(34) & "Mail" & Chr(34) & Chr(13)


scriptToRun = scriptToRun & _
"set NewMail to make new outgoing message with properties " & _
"{content:""" & bodycontent & """, subject:""" & _
mailsubject & """ , visible:true}" & Chr(13)


scriptToRun = scriptToRun & "tell NewMail" & Chr(13)


If toaddress <> "" Then scriptToRun = scriptToRun & _
"make new to recipient at end of to recipients with properties " & _
"{address:""" & toaddress & """}" & Chr(13)


If ccaddress <> "" Then scriptToRun = scriptToRun & _
"make new cc recipient at end of cc recipients with properties " & _
"{address:""" & ccaddress & """}" & Chr(13)


If bccaddress <> "" Then scriptToRun = scriptToRun & _
"make new bcc recipient at end of bcc recipients with properties " & _
"{address:""" & bccaddress & """}" & Chr(13)


If attachment <> "" Then
scriptToRun = scriptToRun & "tell content" & Chr(13)
scriptToRun = scriptToRun & "make new attachment with properties " & _
"{file name:""" & attachment & """ as alias} " & _
"at after the last paragraph" & Chr(13)
scriptToRun = scriptToRun & "end tell" & Chr(13)
End If


If displaymail = False Then scriptToRun = scriptToRun & "send" & Chr(13)
scriptToRun = scriptToRun & "end tell" & Chr(13)
scriptToRun = scriptToRun & "end tell"


If Len(toaddress) + Len(ccaddress) + Len(bccaddress) = 0 Or mailsubject = "" Then
MsgBox "There is no To, CC or BCC address or Subject for this mail"
Exit Function
Else
On Error Resume Next
MacScript (scriptToRun)
On Error GoTo 0
End If
End Function


Function KillFileOnMac(Filestr As String)




'The VBA Kill command on a Mac will not work with long file names(28+ characters)
Dim ScriptToKillFile As String
ScriptToKillFile = ScriptToKillFile & "tell application " & Chr(34) & _
"Finder" & Chr(34) & Chr(13)
ScriptToKillFile = ScriptToKillFile & _
"do shell script ""rm "" & quoted form of posix path of " & _
Chr(34) & Filestr & Chr(34) & Chr(13)
ScriptToKillFile = ScriptToKillFile & "end tell"


On Error Resume Next
MacScript (ScriptToKillFile)
On Error GoTo 0
End Function





Sub Mail_Selection()
'For Excel 2011 for the Mac and Apple Mail
Dim Source As Range
Dim Destwb As Workbook
Dim wb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim FileFormatNum As Long


If Val(Application.Version) < 14 Then Exit Sub


Set Source = Nothing
On Error Resume Next
Set Source = Selection.SpecialCells(xlCellTypeVisible)
On Error GoTo 0


If Source Is Nothing Then
MsgBox "The source is not a range or the sheet is protected, " & _
"please correct and try again.", vbOKOnly
Exit Sub
End If


If ActiveWindow.SelectedSheets.Count > 1 Or _
Selection.Cells.Count = 1 Or _
Selection.Areas.Count > 1 Then
MsgBox "An Error occurred :" & vbNewLine & vbNewLine & _
"You have more than one sheet selected." & vbNewLine & _
"You only selected one cell." & vbNewLine & _
"You selected more than one area." & vbNewLine & vbNewLine & _
"Please correct and try again.", vbOKOnly
Exit Sub
End If


With Application
.ScreenUpdating = False
.EnableEvents = False
End With


Set wb = ActiveWorkbook
Set Destwb = Workbooks.Add(xlWBATWorksheet)


Source.Copy
With Destwb.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial Paste:=xlPasteValues
.Cells(1).PasteSpecial Paste:=xlPasteFormats
.Cells(1).Select
Application.CutCopyMode = False
End With

'pdf extension isn't working. Will try to fix later.
'FileExtStr = ".pdf": FileFormatNum = 17

'Save format and extension
FileExtStr = ".xlsx": FileFormatNum = 52


'Or if you want it in xls format, use:
'FileExtStr = ".xls": FileFormatNum = 57


'Save the new workbook, mail it, and delete it.
'If you want to change the file name then change only TempFileName
TempFilePath = MacScript("return (path to documents folder) as string")
TempFileName = Left(wb.Name, InStr(1, wb.Name, ".", 1) - 1) & " " & Format(Now, "dd-mmm-yy")

'With Destwb.Sheets(1)
' .ExportAsFixedFormat(Type:=xlTypePDF , Filename:= TempFilePath & TempFileName & ".pdf", Quality:= xlQualityStandard)

With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
MailFromMacWithMail bodycontent:="Aquí estan todas las reservas que tenemos para usted." & Chr(13) & Chr(13), _
mailsubject:="Reservas de - ADD COMPANY NAME HERE (2015)", _
toaddress:="", _
ccaddress:="", _
bccaddress:="", _
attachment:=.FullName, _
displaymail:=True
.Close SaveChanges:=False
End With


KillFileOnMac TempFilePath & TempFileName & FileExtStr


With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub