Necesito su ayuda, estoy usando una macro para convertir un rango de celdas una hoja en PDF y luego mandar el mismo por mail; pero el PDF que crea tiene un mal formato, demasiado pequeno, yo necesito que los datos ocupen toda la pagina, esta es la macro y en en adjunto como obtengo el PDF:
Sub SendMailbyOutlookRangoenPdf()
On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim OA, OM As Object
Dim NA As Variant
Dim Path, TD, fn, mydoc As String
TD = Format(Date, "ddmmyyyy")
Path = ThisWorkbook.Path & "\"
fn = ActiveSheet.Name
mydoc = Path & fn & ".pdf"
Dest = Cells(77, "C")
Sheets(fn).Range("A71:C103").Copy
Workbooks.Add
Cells(1, 1).PasteSpecial xlPasteValues
Cells(1, 1).PasteSpecial xlPasteFormats
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
mydoc, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
ActiveWorkbook.Close False
Set OA = CreateObject("Outlook.Application")
Set OM = OA.CREATEITEM(0)
With OM
.To = Dest 'Debes agregar mail destinatario ej "[email protected]"
.CC = ""
.BCC = ""
.Subject = Cells(71, "A")
.Body = Cells(70, "C")
.attachments.Add mydoc
.Send
End With
If Err.Number = 0 Then
SendMail_Gmail = True
MsgBox "El mail con archivo adjunto fue enviado con éxito", vbInformation, "AVISO"
Else
MsgBox "Se produjo el siguiente error: " & Err.Description, vbCritical, "Error nro " & Err.Number
End If
Kill mydoc
Set OM = Nothing
Set OA = Nothing
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Si alguien puede ayudarme por favor, trate de re configurar la pagina cambiando el tamano de la hoja o la orientacion o el zoom pero nada funciona siempre hace el mismo pdf con los datos muy pequenos
Featured Replies
Archivado
Este tema está ahora archivado y está cerrado a más respuestas.
Listes inscrits.pdf
Buen dia
Necesito su ayuda, estoy usando una macro para convertir un rango de celdas una hoja en PDF y luego mandar el mismo por mail; pero el PDF que crea tiene un mal formato, demasiado pequeno, yo necesito que los datos ocupen toda la pagina, esta es la macro y en en adjunto como obtengo el PDF:
Sub SendMailbyOutlookRangoenPdf()
On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim OA, OM As Object
Dim NA As Variant
Dim Path, TD, fn, mydoc As String
TD = Format(Date, "ddmmyyyy")
Path = ThisWorkbook.Path & "\"
fn = ActiveSheet.Name
mydoc = Path & fn & ".pdf"
Dest = Cells(77, "C")
Sheets(fn).Range("A71:C103").Copy
Workbooks.Add
Cells(1, 1).PasteSpecial xlPasteValues
Cells(1, 1).PasteSpecial xlPasteFormats
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
mydoc, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
ActiveWorkbook.Close False
Set OA = CreateObject("Outlook.Application")
Set OM = OA.CREATEITEM(0)
With OM
.To = Dest 'Debes agregar mail destinatario ej "[email protected]"
.CC = ""
.BCC = ""
.Subject = Cells(71, "A")
.Body = Cells(70, "C")
.attachments.Add mydoc
.Send
End With
If Err.Number = 0 Then
SendMail_Gmail = True
MsgBox "El mail con archivo adjunto fue enviado con éxito", vbInformation, "AVISO"
Else
MsgBox "Se produjo el siguiente error: " & Err.Description, vbCritical, "Error nro " & Err.Number
End If
Kill mydoc
Set OM = Nothing
Set OA = Nothing
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Si alguien puede ayudarme por favor, trate de re configurar la pagina cambiando el tamano de la hoja o la orientacion o el zoom pero nada funciona siempre hace el mismo pdf con los datos muy pequenos