Convertir archivo de Excel a PDF y poner clave a archivo PDF.

Tengo el código que se encuentra en internet para ponerle clave a un pdf. El problema que tengo es que cuando se convierte el archivo de Excel a PDF, al parcer este código cambia las márgenes y comprime algunos renglones y se pierden.

¿Cómo te envío el archivo en Excel para que veas el texto? Yo tengo tu correo.

Aquí te pego el código.

Sub Password_PDF()

Dim Password As String, Path As String, File As String
'ActiveSheet.PageSetup.PrintArea = "$A$1:$G$24"
'the area to be printed to PDF
Password = "abc123"
Path = "F:\Anexos Confirmación\Anexos"
File = "pipe.xlsb"
'para utilizar variables
Call PrintToPDFCreator(File, Path, ActiveWorkbook, Password, "User", True, True, True)
'para utilizarlo directo
'PrintToPDFCreator Range("A1") & ".pdf", "C:\Path\", ActiveWorkbook, "Master", "User", True, True, True

End Sub
' *** Visitar el siguiente enlace para encontrar este código:
' *** https://answers.microsoft.com/en-us/msoffice/forum/msoffice_word-mso_win10/save-password-protected-pdf-file-with-vba/e3b0be70-d7a5-421b-888f-980d35386c40 ***
Sub PrintToPDFCreator(sPDFName As String, sPDFPath As String, xlBook As Workbook, Optional sMasterPass As String, _
Optional sUserPass As String, Optional bNoCopy As Boolean, Optional bNoPrint As Boolean, _
Optional bNoEdit As Boolean)
'Graham Mayor - www.gmayor.com
Dim pdfjob As Object
Dim sPrinter As String, sDefaultPrinter As String
Dim iCopy As Integer, iPrint As Integer, iEdit As Integer
If bNoCopy Then iCopy = 1 Else iCopy = 0
If bNoPrint Then iPrint = 1 Else iPrint = 0
If bNoEdit Then iEdit = 1 Else iEdit = 0
sDefaultPrinter = Application.ActivePrinter ' store default printer
sPrinter = GetPrinterFullName("PDFCreator")
If sPrinter = vbNullString Then ' no match
MsgBox "PDFCreator Not Available"
GoTo lbl_Exit
Else
Application.ActivePrinter = sPrinter
Set pdfjob = CreateObject("PDFCreator.clsPDFCreator")
With pdfjob
If .cStart("/NoProcessingAtStartup") = False Then
GoTo err_handler
End If
.cStart "/NoProcessingAtStartup"
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = sPDFPath
.cOption("AutosaveFilename") = sPDFName
.cOption("AutosaveFormat") = 0 ' 0 = PDF
If Not sMasterPass = vbNullString Then
'The following are required to set security of any kind.
.cOption("PDFUseSecurity") = 1
.cOption("PDFOwnerPass") = 1
.cOption("PDFOwnerPasswordString") = sMasterPass 'Put password.
'To set individual security options.
.cOption("PDFDisallowCopy") = iCopy
.cOption("PDFDisallowModifyContents") = iEdit
.cOption("PDFDisallowPrinting") = iPrint
'To force a user to enter a password before opening.
.cOption("PDFUserPass") = 1
.cOption("PDFUserPasswordString") = sUserPass
'To change to high encryption.
.cOption("PDFHighEncryption") = 1
End If
.cClearCache
End With
'Print the workbook to PDF
xlBook.PrintOut
'Wait until the print job has entered the print queue.
Do Until pdfjob.cCountOfPrintjobs = 1
DoEvents
Loop
pdfjob.cPrinterStop = False
'Wait until PDF creator is finished then release the objects.
Do Until pdfjob.cCountOfPrintjobs = 0
DoEvents
Loop
pdfjob.cClose
Application.ActivePrinter = sDefaultPrinter ' restore default printer
End If
lbl_Exit:
Set pdfjob = Nothing
Exit Sub
err_handler:
MsgBox "Unable to initialize PDFCreator." & vbCr & vbCr & _
"This may be an indication that the PDF application has become corrupted, " & _
"or its spooler blocked by AV software." & vbCr & vbCr & _
"Re-installing PDF Creator may restore normal working."
Err.Clear
GoTo lbl_Exit
End Sub
Private Function GetPrinterFullName(Printer As String) As String
' This function returns the full name of the first printerdevice that matches Printer.
' Full name is like "PDFCreator on Ne01:" for a English Windows and like
' "PDFCreator sur Ne01:" for French.
' Created: Frans Bus, 2015. See http://pixcels.nl/set-activeprinter-excel
' see http://blogs.msdn.com/b/alejacma/archive/2008/04/11/how-to-read-a-registry-key-and-its-values.aspx
' see http://www.experts-exchange.com/Software/Microsoft_Applications/Q_27566782.html
Const HKEY_CURRENT_USER = &H80000001
Dim regobj As Object
Dim aTypes As Variant, aDevices As Variant, vDevice As Variant, v As Variant
Dim sValue As String, sLocaleOn As String
'Get locale "on" from current activeprinter.
v = Split(Application.ActivePrinter, Space(1))
sLocaleOn = Space(1) & CStr(v(UBound(v) - 1)) & Space(1)
'Connect to WMI registry provider on current machine with current user.
Set regobj = GetObject("WINMGMTS:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
'Get the Devices from the registry.
regobj.EnumValues HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Devices", aDevices, aTypes
'Find Printer and create full name.
For Each vDevice In aDevices
'Get port of device.
regobj.GetStringValue HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Devices", vDevice, sValue
'Select device.
If Left(vDevice, Len(Printer)) = Printer Then 'Match!
'Create localized printername.
GetPrinterFullName = vDevice & sLocaleOn & Split(sValue, ",")(1)
Exit Function
End If
Next
lbl_Exit:
'At this point no match found.
GetPrinterFullName = vbNullString
Exit Function
End Function

Añade tu respuesta

Haz clic para o