Macro para Enviar rangos de varias hojas como imagen JPEG por Outlook excel
Me gustaria que me ayudaran con una macro para enviar rangos de varias hojas por Outlook como imagen en un solo mensaje este es un ejemplo:
Private Sub CommandButton1_Click()
Range("A1:Y93").Select
With Selection.Font
.ColorIndex = xlAutomatic
.TintAndShade = 0
End With
Range("A1:Y93").Copy
Set dam = CreateObject("outlook.application").createitem(0)
dam.To = "Ingresar correo de CLARO"
dam.Subject = "Diploma " & Range("A1") & "-" & Range("B1")
dam.display
'Application.SendKeys "^v"
Application.Wait Now + TimeValue("00:00:01")
SendKeys "^{home}", True
DoEvents
SendKeys "%nvo", True
DoEvents
SendKeys "{UP}", True
DoEvents
SendKeys "{UP}", True
DoEvents
SendKeys "{ENTER}", True
Set dam = Nothing
End Sub
Pero no puedo colocar el nombre de la hoja ni cuales serian los rangos de cada una como por ejemplo:
Hoja1, Rango: A1:D20
Hoja2. Rango: B2:J30
Hoja3, Rango D10:G30
Los destinatarios puede sern en la misma macro o en una celda
Asunto: en una celda A1 y B2
Nombre del Archivo: en una celda
H o l a:
La macro que pusiste copia el rango de celdas y lo copia como imagen en el cuerpo del mail.
Lo que no entiendo, quieres las imágenes en el cuerpo del coreo, o quieres que el rango de celdas se guarde como una imagen jpeg en un archivo y ese archivo agregarlo al correo, sería un sol archivo con 3 imágenes o 3 archivos, ¿cada archivo con una imagen?
Si solamente quieres que en el cuerpo de correo se peguen las 3 imágenes, entonces utiliza la siguiente macro:
Sub CommandButton1_Click()
'Por.Dante Amor
hojas = Array("Hoja1", "Hoja2", "Hoja3")
rango = Array("A1:D20", "B2:J30", "D10:G30")
Set dam = CreateObject("outlook.application").createitem(0)
dam.To = "[email protected]; [email protected]"
dam.Subject = "Diploma " & Sheets("Hoja1").Range("A1").Value & "-" & _
Sheets("Hoja1").Range("B1").Value
dam.display
Application.Wait Now + TimeValue("00:00:01")
DoEvents
SendKeys "^{home}", True
DoEvents
For i = LBound(hojas) To UBound(hojas)
Sheets(hojas(i)).Range(rango(i)).Copy
SendKeys "%nvo", True
DoEvents
SendKeys "{UP}", True
DoEvents
SendKeys "{UP}", True
DoEvents
SendKeys "{ENTER}", True
DoEvents
SendKeys "{ENTER}", True
Next
Application.CutCopyMode = False
End SubTe explico el funcionamiento
En esta línea tienes que poner el nombre de las hojas:
hojas = Array("Hoja1", "Hoja2", "Hoja3")En esta, los rangos, un rango por cada hoja
rango = Array("A1:D20", "B2:J30", "D10:G30")En esta, los correos
dam.To = "[email protected]; [email protected]"
Si vas a poner el correo en una celda, tienes que indicar la hoja y la celda, por ejemplo:
dam.To = sheets("Hoja1").range("C1").value'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
