Guardar en PDF cada una de las celdas de una columna.
Para Dante Amor. Hola de nuevo, quiero hacer lo siguiente: Tengo en la columna B, Rango (B3:B370), datos que quiero exportar a PDF, quiero generar un PDF por cada contenido de una celda, es decir un PDF para la B3, un PDF para la B4... Hasta la 370, tengo una macro que genera el PDF de la celda seleccionada, pero solo de la que esta seleccionada, ¿cómo le hago para que terminando el PDF de esa celda seleccione la celda inferior: B4 luego B5, etc hasta la 370? En total necesito generar 370 archivos PDF
Sub PDF_CELDA()
Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Users\itumi\Desktop\PRUEBAS\" & Sheets("REGISTRO").Range("B3") & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False
End Sub
1 respuesta
Ya entendí, disculpa, pensé que solamente querías el código para enviar correos.
Te anexo la macro para lo siguiente:
- En la hoja "registro", en la columna A, pon tus nombres, iniciando en la fila 2
- En la columna B pon los correos de los destinatarios
- La macro genera un pdf por cada nombre que se encuentra en la columna A, solamente pone el contenido de la celda de la columna A
- Al pdf le pone por nombre el valore de la celda de la columna
- Cambia en la macro "[email protected]" por tu correo de gmail y "pwd" por tu password
- La macro te pone en la columna C por cada nombre, si el correo se envió o tuvo algún error.
- La macro:
Sub Pdf_Enviar_Correos_Gmail()
'---
' Por.Dante Amor
'---
'***Macro Para enviar correos por Gmail
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set h = Sheets("REGISTRO")
'
correo = "[email protected]" 'correo gmail
passwd = "pwd" 'tu password
'
ruta = "C:\Users\itumi\Desktop\PRUEBAS\"
'ruta = ThisWorkbook.Path & "\"
h.Select
For i = 2 To Range("B" & Rows.Count).End(xlUp).Row
'
archivo = ruta & Cells(i, "A").Value & ".pdf"
Cells(i, "A").ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=archivo, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
'
Dim Email As CDO.Message
Set Email = New CDO.Message
Email.Configuration.Fields(cdoSMTPServer) = "smtp.gmail.com"
Email.Configuration.Fields(cdoSendUsingMethod) = 2
With Email.Configuration.Fields
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = CLng(465)
.Item("http://schemas.microsoft.com/cdo/" & "configuration/smtpauthenticate") = Abs(1)
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = correo
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = passwd
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
End With
With Email
.To = Range("B" & i).Value 'Destinatarios
.From = correo
.Subject = "Asunto"
.TextBody = "Cuerpo del mensaje"
If Dir(archivo) <> "" Then
.AddAttachment archivo
End If
.Configuration.Fields.Update
On Error Resume Next
.Send
If Err.Number = 0 Then
Cells(i, "C") = "El mail se envió con éxito"
Else
Cells(i, "C") = "Se produjo el siguiente error: " & Err.Number & " " & Err.Description
End If
On Error GoTo 0
End With
Set Email = Nothing
Next
MsgBox "Correos enviados", vbInformation, "SALUDOS"
End Sub.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
.
Avísame cualquier duda
.
