Mrrrr's Forum (VIEW ONLY)
Un forum care ofera solutii pentru unele probleme legate in general de PC. Pe langa solutii, aici puteti gasi si alte lucruri interesante // A forum that offers solutions to some PC related issues. Besides these, here you can find more interesting stuff.
|
Lista Forumurilor Pe Tematici
|
Mrrrr's Forum (VIEW ONLY) | Reguli | Inregistrare | Login
POZE MRRRR'S FORUM (VIEW ONLY)
Nu sunteti logat.
|
Nou pe simpatie:
barbyy
 | Femeie
23 ani
Bucuresti
cauta Barbat
23 - 80 ani |
|
|
TRaP
Moderator
Inregistrat: acum 6 ani
Postari: 748
|
|
Code source:
Made a new macro-enabled excel file, empty, named Export to PDF.xlsm.
I opened it and in ThisWorkbook I pasted the following code:
Private Sub Workbook_Open()
Call ExportExcelFilesToPDF
End Sub
|
The code above will call the macro below and when the excel file opens, it will automatically run the macro and ask the user for folder locations of xlsx files and for folder location where PDF files are to be saved.
Then I made a new Module where I pasted the code below:
Sub ExportExcelFilesToPDF()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim OpenSourceFolder As Object
Dim OpenTargetFolder As Object
Dim SelectedExcelFilesFolder As String
Dim SelectedPdfFilesFolder As String
Dim InputExcelFile As String
Dim MyOpenedExcel As Workbook
Dim OutputPdfFile As String
Set OpenSourceFolder = Application.FileDialog(msoFileDialogFolderPicker)
Set OpenTargetFolder = Application.FileDialog(msoFileDialogFolderPicker)
'Select input data folder
MsgBox ("Selecteaza FOLDERUL SURSA unde se gasesc fisierele Excel")
Set OpenSourceFolder = Application.FileDialog(msoFileDialogFolderPicker)
If OpenSourceFolder.Show = -1 Then
SelectedExcelFilesFolder = OpenSourceFolder.SelectedItems(1)
Else
MsgBox ("Ai anulat selectarea folderului, fisierele nu au fost salvate")
Exit Sub
End If
AppActivate Application.Caption
'Select output folder
MsgBox ("Selecteaza FOLDERUL DESTINATIE unde vor fi salvate PDF-urile")
If OpenTargetFolder.Show = -1 Then
SelectedPdfFilesFolder = OpenTargetFolder.SelectedItems(1)
Else
MsgBox ("Ai anulat selectarea folderului, fisierele nu au fost salvate")
Exit Sub
End If
'Looping through only xlsx files in input file folder
InputExcelFile = Dir(SelectedExcelFilesFolder & "\*.xlsx")
While InputExcelFile <> ""
Set MyOpenedExcel = Workbooks.Open(SelectedExcelFilesFolder & "\" & InputExcelFile)
OutputPdfFile = SelectedPdfFilesFolder & "\" & Replace(ActiveWorkbook.Name, "xlsx", "pdf")
'Save each excel file as pdf file, the newly pdf file will be located where original excel file was located
ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=OutputPdfFile, Quality:=xlQualityStandard _
, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
MyOpenedExcel.Close
InputExcelFile = Dir
Wend
End Sub
|
I modified the code from source a bit to exit sub in case cancel is pressed when folder selection dialog is opened.
|
|
| pus acum 4 ani |
|