I'm so relieved that I finally got the code below to work with the help of this community.
I have one more option on my wishlist that I'm struggling with. Currently, the code below will save worksheet 3 all the way to worksheet titled "post" as separate PDF files into a folder I select. This is triggered by a shape.
I'm trying to make the below code prompt a folder select so users can select where their PDF files are saved, does anyone have any ideas how to do this?
Also, the Call Shell at the bottom would preferably open the folder where the files are saved, but that's not really necessary as long as users know where the files are being saved :)
Sub SaveAllPDF()
Dim i As Integer
Dim Fname As String
Dim TabCount As Long
TabCount = Sheets("Post").Index
'Set the TabCount to the last cell you want to PDF
' Begin the loop.
For i = 3 To TabCount
'Set i = the number of the first sheet you want to PDF in order from left to right To TabCount
If Sheets(i).Visible <> xlSheetVisible Then
Else
With Sheets(i)
Fname = .Range("C15") & " " & .Range("E13") & "-" & .Range("B1")
'The Fname above is equaling the cells that the PDF's filename will be
'The folder directory below is where the PDF files will be saved
.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Users\Brandon\Desktop\operation automated\RLtemp\" & Fname, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End With
End If
Next i
Call Shell("explorer.exe" & " " & "C:\Users\Brandon\Desktop\operation automated\RLtemp\", vbNormalFocus)
'This opens the folder where the PDFs are saved
End Sub
You can just use the Excel's FileDialog object:
Sub SaveAllPDF()
Dim i As Integer
Dim Fname As String
Dim TabCount As Long
TabCount = Sheets("Post").index
'Set the TabCount to the last cell you want to PDF
Dim dialog As FileDialog
Dim path As String
Set dialog = Application.FileDialog(msoFileDialogFolderPicker)
dialog.AllowMultiSelect = False
If dialog.Show = -1 Then
path = dialog.SelectedItems(1)
' Begin the loop.
For i = 3 To TabCount
'Set i = the number of the first sheet you want to PDF in order from left to right To TabCount
If Sheets(i).Visible <> xlSheetVisible Then
Else
With Sheets(i)
Fname = .Range("C15") & " " & .Range("E13") & "-" & .Range("B1")
'The Fname above is equaling the cells that the PDF's filename will be
'The folder directory below is where the PDF files will be saved
.ExportAsFixedFormat Type:=xlTypePDF, filename:=path & "\" & Fname, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End With
End If
Next i
Call Shell("explorer.exe" & " " & path & "\", vbNormalFocus)
'This opens the folder where the PDFs are saved
End If
End Sub
Related
I have the code below. It makes me wonder why the BeforePrint event in the workbook codes is fired even though I am not printing anything. The workbook definitely is not blank. The error is in the creation of the PDF file.
The file does a simple job of saving the worksheet in a PDF format with the name of the sheet, the file path of the workbook, and some details inside the worksheet.
Anything that I am missing? I am not new to VBA but this bugs me a lot today. I am using MS Excel 2016 on Windows 7 ultimate.
Edit: I tried removing the following codes below but the problem still persists:
IgnorePrintAreas:=False, _
OpenAfterPublish:=True
The code is as follows:
Option Explicit
Public Sub createpdffile()
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
Dim sheetname As String, sheetcode As String
Dim iRow As Long
Dim openPos As Integer
Dim closePos As Integer
'temporarily disable error handler so that I can see where the bug is.
'On Error GoTo errHandler
Set wbA = ActiveWorkbook
Set wsA = ActiveSheet
wbA.Save
'get last row of sheet and set print area to last row with L column
iRow = wsA.Cells(Rows.Count, 1).End(xlUp).Row
wsA.PageSetup.PrintArea = wsA.Range("A1:L" & iRow).Address
'just checking name in sheet and removing needed characters
sheetname = wsA.Name
openPos = InStr(sheetname, "(")
closePos = InStr(sheetname, ")")
sheetcode = Mid(sheetname, openPos + 1, closePos - openPos - 1)
'get active workbook folder, if saved
strPath = wbA.Path
If strPath = "" Then
strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"
'create default name for saving file
strFile = sheetcode & " No. " & wsA.Cells(11, 9) & " - " & wsA.Cells(8, 3) & ".pdf"
strPathFile = strPath & strFile
'use can enter name and
' select folder for file
myFile = Application.GetSaveAsFilename _
(InitialFileName:=strPathFile, _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Folder and FileName to save")
'export to PDF if a folder was selected
'THIS IS WHERE THE ERROR IS LOCATED
If myFile <> "False" Then
wsA.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=myFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True
'confirmation message with file info
MsgBox "PDF file has been created: " _
& vbCrLf _
& myFile
End If
exitHandler:
Exit Sub
errHandler:
MsgBox "Could not create PDF file" & vbNewLine & _
"Please complete the details needed!", vbOKOnly + vbExclamation, "Error Saving as PDF"
Resume exitHandler
End Sub
Solution from Foxfire and Burns and Burns' idea:
I added a public declaration before the main sub.
Option Explicit
'added line
Public myboolean as Boolean
Public Sub createpdffile()
myboolean = True
....
Then I added a line in the BeforePrint Event that says:
If myboolean = True Then Exit Sub
This now bypasses the BeforePrint event when the virtual PDF printer is called.
wsA.ExportAsFixedFormat
That line activates the BeforePrint Event. Actually, you are printing a PDF file. It works as a virtual PDF Printer.
I made a virtual lab in powerpoint for highschool students, once in a while there is a slide where they are asked a question. They can leave their answer in a Textbox.
At the end i want to insert a button that contains a macro which will save only the slides on which there was a question to a PDF file. The other slides are irrelevant for the teacher.
In short: I am trying to make a PowerPoint macro where I can save a selection of slides as a PDF. Its not a range of slides, but a selection of slides.
Currently i have this:
Private Sub CommandButton2_Click()
Dim mySlides As Variant
Dim PR As PrintRange
Dim savePath As String
Dim myInput As String
'Add the name of the student in the file name
myInput = ActivePresentation.Slides(1).Shapes("TextBox2").OLEFormat.Object.Text
'Location of saved file
savePath = ActivePresentation.Path & "\" & myInput & " Antwoorden Virtueel Lab" & ".pdf"
If ActivePresentation.Slides(9).Shapes("TextBox1").OLEFormat.Object.Text = "PRARDT" Then
mySlides = Array(9, 11, 15)
Set PR = ActivePresentation.Slides.Range(mySlides)
ActivePresentation.ExportAsFixedFormat _
Path:=savePath, _
FixedFormatType:=ppFixedFormatTypePDF, _
PrintRange:=PR, _
Intent:=ppFixedFormatIntentScreen, _
FrameSlides:=msoTrue, _
RangeType:=ppPrintSlideRange
Else: MsgBox "Does not work"
End If
End Sub
However its not working
If I want to do it with a range of slides than i can use this code (Which does work):
Private Sub CommandButton3_Click()
'This function saves the last slide as a PDF file with a time stamp and the users name who completed the induction.
Dim PR As PrintRange
Dim savePath As String
Dim myInput As String
myInput = ActivePresentation.Slides(1).Shapes("TextBox2").OLEFormat.Object.Text
'Location of saved file
savePath = ActivePresentation.Path & "\" & myInput & " Antwoorden Virtueel Lab" & ".pdf"
If ActivePresentation.Slides(9).Shapes("TextBox1").OLEFormat.Object.Text = "PRARDT" Then
With ActivePresentation.PrintOptions
.Ranges.ClearAll ' always do this
Set PR = .Ranges.Add(9, 21)
End With
ActivePresentation.ExportAsFixedFormat _
Path:=savePath, _
FixedFormatType:=ppFixedFormatTypePDF, _
PrintRange:=PR, _
Intent:=ppFixedFormatIntentScreen, _
FrameSlides:=msoTrue, _
RangeType:=ppPrintSlideRange
Else
MsgBox "something went wrong"
End If
End Sub
This macro does work, but i can only print a range of slides with it or 1 specific slide. I want to print an Array of specific slides to PDF. I have looked at related questions on this topic however i am such a big noob that i can't fix my problem even with their closely related examples.
I did it! I finally found where the error's came from and now have a working macro
Private Sub CommandButton4_Click()
Dim myInput As String
Dim savePath As String
'Name of Student
myInput = ActivePresentation.Slides(1).Shapes("TextBox2").OLEFormat.Object.Text
'Location of saved file
savePath = ActivePresentation.Path & "\" & myInput & " Antwoorden Virtueel Lab" & ".pdf"
'Select path student took
If ActivePresentation.Slides(9).Shapes("TextBox1").OLEFormat.Object.Text = "PRARDT" Then
'Change view
ActivePresentation.SlideShowWindow.View.Exit
'Prevents error
ActiveWindow.Panes(1).Activate
'Select specific slides
ActivePresentation.Slides.Range(Array(9, 11, 15)).Select
'save selected slides as PDF
ActivePresentation.ExportAsFixedFormat Path:=savePath, FixedFormatType:=ppFixedFormatTypePDF, RangeType:=ppPrintSelection
MsgBox "file saved"
Else
MsgBox "wont work"
End If
End Sub
Now i ll make 9 different if then and select which slides need to be saved for for each path.
I have a folder with several excel workbooks that I need to export to pdf. There is a logo (.bmp) on each sheet of each workbook. When I use the below code, the pdfs are all missing the logo (it has a grey placeholder instead) on ONLY the first page. The rest of the pages have the logo.
My code:
Option Explicit
Sub dsPdf()
Dim path As String
Dim wbName As String
Dim tWb As Workbook
Dim t As Single
path = ThisWorkbook.path
wbName = Dir(path & "\*.xlsx")
Application.ScreenUpdating = True
Do While wbName <> ""
Set tWb = Workbooks.Open(path & "\" & wbName)
tWb.Sheets(Array(1, 2, 3)).Select
DoEvents
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
path & "\" & Left(wbName, Len(wbName) - 4) & "pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
tWb.Close False
wbName = Dir
Loop
End Sub
I've tried using ActiveSheet.RefreshAll and DoEvents, as well as adding a Timer/Do While loop. When I put Stop before the export statement, the first sheet shows the logo correctly. However when I put Aplication.Wait(Now... the logo does not show.
Any ideas?
Thanks
Try this - I avoided the use of .Select, as (I'm not sure) but I think that could be causing some issues.
Sub dsPdf_NoSelect()
Dim path As String
Dim wbName As String
Dim tWb As Workbook
Dim t As Single
Dim i As Long
path = ThisWorkbook.path
wbName = Dir(path & "\*.xlsx")
Application.ScreenUpdating = True
Do While wbName <> ""
Set tWb = Workbooks.Open(path & "\" & wbName)
For i = 1 To 3
tWb.Sheets(i).ExportAsFixedFormat Type:=xlTypePDF, Filename:=path & "\" & Left(wbName, Len(wbName) - 4) & "pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Next i
tWb.Close False
wbName = Dir
Loop
End Sub
I am trying to write some code that will save several tabs as a pdf document in folder specified by files within excell. I would like for cells within the document to dictate where this file is saved. I am not sure if this is possibly, but if it is any help would be good! I am currently getting a Run-time error '1004' during the save process of my code.
And yes, I do have the folders created that are being referenced.
Sub asdf()
Dim Fname As String
Dim Fpath As String
Dim YrMth As String
Fname = Sheets("Sheet1").Range("A1").Text
YrMth = Sheets("Sheet1").Range("A2").Text & "\" & Sheets("Sheet1").Range("A3").Text
Fpath = "C:\Documents and Settings\My Documents\" & YrMth & "\Group\" & Fname & ".pdf"
ThisWorkbook.Sheets(Array("Sheet1", "Sheet2", "Sheet4")).Select
Application.DisplayAlerts = False
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=Fpath, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True
End Sub
Your code works for me, but not with the path you've specified.
Declare a new string variable:
dim myDocsPath as String
Get the path using:
myDocsPath = Environ$("USERPROFILE") & "\My Documents\"
and then change your definition for Fpath to:
Fpath = myDocsPath & YrMth & "\Group\" & Fname & ".pdf"
If I change the end of myDocsPath to & "\My foo Documents\" I get the same 1004 error you are getting.
Try replace line in your code
Fpath = "C:\Documents and Settings\My Documents\" & YrMth & "\Group\" & Fname & ".pdf"
with
Dim WshShell As Object
Dim MyDocsFolder As String
Set WshShell = CreateObject("WScript.Shell")
MyDocsFolder = WshShell.SpecialFolders("MyDocuments") & "\"
Fpath = MyDocsFolder & YrMth & "\Group\" & Fname & ".pdf"
Edit:
The core of this solution is in line:
MyDocsFolder = WshShell.SpecialFolders("MyDocuments") & "\"
which returns system path to My Documents, irrespectively from local system settings like language or nonstandard location of My Documents folders. Then it adds a backslash at the end.
It is more elegant (and the code becomes more portable) if you ask system about special folders than hardcode such data in your script.
More on Windows special folders in VBA you can find https://www.rondebruin.nl/win/s3/win027.htm
I have never written VBA code, but I checked on internet for some information.
My wish is the following: I have an Excel file with 3 sheets. On one of them, I'd like to add one button which can:
Save the totality of my Excel file following this naming convention: [name of a cells of a page]_AP_[date of today].xls.
Save one of the sheets in a .pdf file.
Print 2 of the 3 sheets while adjusting the contents.
I already started something, but I'm really bad at programming:
Public Sub Savefile_Click() 'copie sauvegarde classeur
' save my file following a name
Dim nom As String
Dim chemin As String
Dim wSheet As Worksheet
chemin = "C:\Users\aaa\Desktop"
nom = [Q13].Value & "_" & Day(Date) & "-" & Month(Date) & "-" & Year(Date) _
& ".xlsm"
With ActiveWorkbook
.SaveAs Filename:=chemin & nom
.Close
rep = MsgBox("Fichier excell sauvegardé")
End With
' ... and print my active sheet (where the button will stay)
For Each wSheet In ActiveWorkbook.Worksheets
If wSheet.Visible Then wSheet.PrintOut
Next
'Save my page 'offre' in pdf on my desktop and print it
Worksheets("OFFRE A ENVOYER").Range("A1:i47").ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=[Q13].Value & "_Offre de prix", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End Sub
After that there will be another option and details, but this is really the base.
1) Save as Excel
Dim nom As String
nom = ThisWorkbook.Sheets(1).Range("Q13").Value & "AP" & Format(Date, "ddmmyyyy") & ".xls"
thisworkbook.saveas sPath & nom 'Define path first, don't forget the \ at the end.
Even better would be to create a named range from range "Q13" and use:
nom = thisworkbook.names("Something").referstorange.value
To make the link dynamic in case you insert a column or row which shifts all your ranges.
2) Save workbook as PDF
ThisWorkbook.ExportAsFixedFormat xlTypePDF, sPath & sFile 'Define here .pdf
3)
"print 2 of the 3sheets with adjusting the contenant of a "
I'm not sure if I get this one...
Print command is given by:
Set oSheet= thisworkbook.sheets(2)
with oSheet.PageSetup
.PrintArea = "$A1$1:$Q$40"
...
'Any other properties: http://www.java2s.com/Code/VBA-Excel-Access-Word/Excel/AllpropertiesofPageSetup.htm
end with
oSheet.printout
Which ever way you want to program this in order to retrieve the sheets that you need to print.
You can loop through the sheets with a counter and put if statements to add conditions.
dim oSheet as Excel.worksheet
dim iCnt as integer
For each oSheet in thisworkbook.sheets
iCnt = iCnt + 1
'Include conditions here
If ... then 'Whatever condition
set oSheet = thisworkbook.sheets(iCnt)
'Print
end if
next oSheet
thank you ...i was searching this. this worked very well.
Option Explicit
Sub SvMe() 'Save filename as value of A1 plus the current date
Dim newFile As String, fName As String
' Don't use "/" in date, invalid syntax
fName = Range("A1").Value
newFile = fName & " " & Format$(Date, "mm-dd-yyyy")
' Change directory to suit
ChDir _
"C:\Users\user\Desktop" 'YOU MUST Change USER NAME to suit
ThisWorkbook.ExportAsFixedFormat xlTypePDF, Filename:=newFile
End Sub
this
1. saves my file in pdf format and
2. does not prompt me for attending save as dialog box
3. saves file using cell value in A1 and date stamp