Necesito que mi macro, que la adjunto guarde en PDF y envíe por mail
$$\begin{align}&Sub CopiaryPegar()\\&'\\&' CopiaryPegar Macro\\&'\\&\\&'\\&ActiveCell.Range("A1:BD1").Select\\&Selection.Copy\\&Application.Goto Reference:="Registrobase"\\&ActiveSheet.Paste\\&Application.CutCopyMode = False\\&Application.Goto 'Reference:="Hoja1!R[3]C[-52]:R[3]C[-52]"\\&ActiveCell.Offset(1, 0).Range("A1").Select\\&\end Sub\\&Sub PreparaImpresion()\\&'\\&' PreparaImpresion Macro\\&'\\&\\&'\\&Application.Goto Reference:="Recibos"\\&ActiveSheet.PageSetup.PrintArea = "$B$1:$U$92"\\&With ActiveSheet.PageSetup\\&.PrintTitleRows = ""\\&.PrintTitleColumns = ""\\&\end With\\&ActiveSheet.PageSetup.PrintArea = "$B$1:$U$92"\\&With ActiveSheet.PageSetup\\&.LeftHeader = ""\\&.CenterHeader = ""\\&.RightHeader = ""\\&.LeftFooter = ""\\&.CenterFooter = ""\\&.RightFooter = ""\\&.LeftMargin = Application.InchesToPoints(0.15748031496063)\\&.RightMargin = Application.InchesToPoints(0.15748031496063)\\&.TopMargin = Application.InchesToPoints(0.47244094488189)\\&.BottomMargin = Application.InchesToPoints(0.748031496062992)\\&.HeaderMargin = Application.InchesToPoints(0.31496062992126)\\&.FooterMargin = Application.InchesToPoints(0.31496062992126)\\&.PrintHeadings = False\\&.PrintGridlines = False\\&.PrintComments = xlPrintNoComments\\&.PrintQuality = 600\\&.CenterHorizontally = True\\&.CenterVertically = True\\&.Orientation = xlPortrait\\&.Draft = False\\&.PaperSize = xlPaperA4\\&.FirstPageNumber = xlAutomatic\\&.Order = xlDownThenOver\\&.BlackAndWhite = False\\&.Zoom = 70\\&.PrintErrors = xlPrintErrorsDisplayed\\&.OddAndEvenPagesHeaderFooter = False\\&.DifferentFirstPageHeaderFooter = False\\&.ScaleWithDocHeaderFooter = True\\&.AlignMarginsHeaderFooter = True\\&.EvenPage.LeftHeader.\text = ""\\&.EvenPage.CenterHeader.\text = ""\\&.EvenPage.RightHeader.\text = ""\\&.EvenPage.LeftFooter.\text = ""\\&.EvenPage.CenterFooter.\text = ""\\&.EvenPage.RightFooter.\text = ""\\&.FirstPage.LeftHeader.\text = ""\\&.FirstPage.CenterHeader.\text = ""\\&.FirstPage.RightHeader.\text = ""\\&.FirstPage.LeftFooter.\text = ""\\&.FirstPage.CenterFooter.\text = ""\\&.FirstPage.RightFooter.\text = ""\\&\end With\\&\end Sub\\&Sub AInicioBase()\\&'\\&' AInicioBase Macro\\&'\\&\\&'\\&Application.Goto Reference:="InicioBase"\\&\end Sub\\&\\&Sub ImprimeRecibos()\\&PreparaImpresion\\&AInicioBase\\&While ActiveCell <> ""\\&Derecha16\\&If ActiveCell > 0 Then\\&Izquierda16\\&CopiaryPegar\\&Worksheets("Hoja2").PrintPreview\\&Else\\&Abajo1\\&\end If\\&Wend\\&\end Sub\\&Sub Abajo1()\\&'\\&' Abajo1 Macro\\&'\\&\\&'\\&ActiveCell.Offset(1, 0).Range("A1").Select\\&\end Sub\end{align}$$Tengo esta macro y la verdad intente de todas maneras para que guarde el archivo en una carpeta determinada con el nombre de la hoja 2 en la celda E 8 y si tiene dirección de correo en la celda R 10 de la hoja 2.
Adjunto mi macro es rudimentaria pero necesito mejorarla y la verdad no se..
AYUDA!!
3 respuestas
Por alguna causa, la macro que pusiste se almacenó con código de HTML o algo así. Podrías ponerla nuevamente, pero no la pongas en "Insertar código fuente", ponla directamente en la página.
¿Ahora podrías explicar con ejemplos cómo quieres que se llame el archivo y qué datos quieres poner en las celdas?
O bien envíame tu archivo de excel y también me envías el PDF de excel con el nombre final.
Con la siguiente macro puedes imprimir todos los recibos. Lo que hace es copiar la información de la hoja1 en la hoja2 y luego genera el archivo PDF
Sub PDFyCorreo()
'Por.Dante Amor
Set h1 = Sheets("Hoja1")
Set h2 = Sheets("Hoja2")
'
For i = 5 To h1.Range("A" & Rows.Count).End(xlUp).Row
h1.Range("A" & i & ":BD" & i).Copy h2.[V2]
nombreLibro = h2.Range("E8")
ruta = "C:\Users\Usuario\Documents\Clientes Luciano\sol parana\"
h2.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=ruta & nombreLibro & ".pdf", _
Quality:=xlQualityStandar, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
Next
End SubFalta lo del correo, revisa esta parte y después vemos lo del correo.
Saludos. Dante Amor
¡Gracias! Mil Gracias
Esta es la macro para enviar por correo.
Sub PDFyCorreo()
'Por.Dante Amor
Set h1 = Sheets("Hoja1")
Set h2 = Sheets("Hoja2")
'
For i = 5 To h1.Range("A" & Rows.Count).End(xlUp).Row
h1.Range("A" & i & ":BD" & i).Copy h2.[V2]
ruta = "C:\Users\Usuario\Documents\Clientes Luciano\sol parana\"
ruta = "C:\trabajo\"
nombreLibro = h2.Range("E8") & ".pdf"
h2.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=ruta & nombreLibro, _
Quality:=xlQualityStandar, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
'enviar Correo
If InStr(1, h2.[S10], "@") > 0 Then
Set dam = CreateObject("outlook.application").createitem(0)
dam.To = h2.[S10]
dam.Subject = "Recibo"
dam.Body = "Archivo pdf"
dam.Attachments.Add ruta & nombreLibro
dam.send
End If
Next
End Sub
Sub Macro1() ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ "aqui poner donde quieres que se guarde el archivo.pdf", Quality:= _ xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _ OpenAfterPublish:=False ' Select the range of cells on the active worksheet. ' Show the envelope on the ActiveWorkbook. ActiveWorkbook.EnvelopeVisible = True ' Set the optional introduction field thats adds ' some header text to the email body. It also sets ' the To and Subject lines. Finally the message ' is sent. With ActiveSheet.MailEnvelope .Introduction = "This is a sample worksheet." .Item.To = "[email protected]" .Item.Subject = "My subject" .Item.Attachments.Add = "aqui poner donde quieres que se guarde el archivo.pdf" .Item.Send End WithEnd Sub
Así quedaría
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ "aqui poner donde quieres que se guarde el archivo.pdf", Quality:= _ xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _ OpenAfterPublish:=FalseEste codigo te guarda el archivo como PDF ahora neecsitas algo que te carge el archivo en el correo - Victor Coello