Automatitzacio d’impressio VBA (versió Acrobat Distiller)

23
Nov

Aquesta rutina d’VBA serveix per aplicar un format concret i transformar a PDF tots els fitxers .xls que pengin de les subcarpetes d’un directori

Option Explicit

Sub ArreglarMargeITransformarAPDF()

Dim fs, f, f1, sf
Dim folderspec
Dim MiNombre As String

folderspec = “C:\Directori”

Set fs = CreateObject(“Scripting.FileSystemObject”)
Set f = fs.GetFolder(folderspec)
Set sf = f.SubFolders
For Each f1 In sf
Debug.Print f1.Name
MiNombre = Dir(folderspec & f1.Name & “\”)
Do While MiNombre <> “”
If MiNombre Like “*.xls” Then
Workbooks.Open folderspec & f1.Name & “\” & MiNombre
Call arreglarFormat
Call imprimirPDF(folderspec & f1.Name & “\”, Replace(MiNombre, “.xls”, “.pdf”))
ActiveWorkbook.Close savechanges:=True
End If
MiNombre = Dir
Loop
Debug.Print “Imprimit ” & f1.Name
Next

End Sub

Public Sub arreglarFormat()

With ActiveSheet.PageSetup
.LeftMargin = Application.InchesToPoints(0.15)
.RightMargin = Application.InchesToPoints(0.15)
.TopMargin = Application.InchesToPoints(0.15)
.BottomMargin = Application.InchesToPoints(0.15)
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
.PrintErrors = 0
.PaperSize = xlPaperA3
End With

End Sub

Private Sub imprimirPDF(Directori, Fitxer)

Dim PSFileName As String
Dim PDFFileName As String
PSFileName = “c:\tempPOA.ps”
PDFFileName = Directori & Fitxer

‘ Imprimir la fulla
Dim MySheet As Worksheet
Set MySheet = ActiveSheet
MySheet.Activate
MySheet.PrintOut copies:=1, preview:=False, ActivePrinter:=”PDFCreator”, _
printtofile:=True, collate:=True, prtofilename:=PSFileName

‘ Convertir a PDF
Dim myPDF As PdfDistiller
Set myPDF = New PdfDistiller
myPDF.FileToPDF PSFileName, PDFFileName, “”

‘Esborrar el fitxer temporal ps i el de log
Kill PSFileName
Kill Directori & Replace(Fitxer, “.pdf”, “.log”)
End Sub