Consejo: Otros idiomas son traducidos por Google. Puedes visitar el English versión de este enlace.
Iniciar sesión
x
or
x
x
Suscríbete
x

or

¿Cómo pegar un rango de celdas en el cuerpo del mensaje como imagen en Excel?

Si necesita copiar un rango de celdas y pegarlo como una imagen en el cuerpo del mensaje cuando envía un correo electrónico desde Excel. ¿Cómo podrías lidiar con esta tarea?

Pegue un rango de celdas en el cuerpo del correo electrónico como imagen con código VBA en Excel


Pegue un rango de celdas en el cuerpo del correo electrónico como imagen con código VBA en Excel


Puede que no haya otro buen método para resolver este trabajo, un código de VBA en este artículo puede ayudarlo. Por favor haz lo siguiente:

1. Habilite la hoja que desea copiar y pegue las celdas como imagen, mantenga presionada la tecla ALT + F11 teclas para abrir el Microsoft Visual Basic para aplicaciones ventana.

2. Hacer clic recuadro > Móduloy pegue el siguiente código en Módulo Ventana.

Código de VBA: pegue un rango de celdas en el cuerpo del correo electrónico como imagen:

Sub sendMail()
        Dim TempFilePath As String
        Dim xOutApp As Object
        Dim xOutMail As Object
        Dim xHTMLBody As String
        Dim xRg As Range
        On Error Resume Next
        Set xRg = Application.InputBox("Please select the data range:", "KuTools for Excel", Selection.Address, , , , , 8)
        If xRg Is Nothing Then Exit Sub
        With Application
            .Calculation = xlManual
            .ScreenUpdating = False
            .EnableEvents = False
        End With
        Set xOutApp = CreateObject("outlook.application")
        Set xOutMail = xOutApp.CreateItem(olMailItem)
        Call createJpg(ActiveSheet.Name, xRg.Address, "DashboardFile")
        TempFilePath = Environ$("temp") & "\"
        xHTMLBody = "<span LANG=EN>" _
                & "<p class=style2><span LANG=EN><font FACE=Calibri SIZE=3>" _
                & "Hello, this is the data range that you want:<br> " _
                & "<br>" _
                & "<img src='cid:DashboardFile.jpg'>" _
                & "<br>Best Regards!</font></span>"
        With xOutMail
            .Subject = ""
            .HTMLBody = xHTMLBody
          .Attachments.Add TempFilePath & "DashboardFile.jpg", olByValue
            .To = " "
            .Cc = " "
            .Display
        End With
End Sub
Sub createJpg(SheetName As String, xRgAddrss As String, nameFile As String)
    Dim xRgPic As Range
    ThisWorkbook.Activate
    Worksheets(SheetName).Activate
    Set xRgPic = ThisWorkbook.Worksheets(SheetName).Range(xRgAddrss)
    xRgPic.CopyPicture
    With ThisWorkbook.Worksheets(SheetName).ChartObjects.Add(xRgPic.Left, xRgPic.Top, xRgPic.Width, xRgPic.Height)
        .Activate
        .Chart.Paste
        .Chart.Export Environ$("temp") & "\" & nameFile & ".jpg", "JPG"
    End With
    Worksheets(SheetName).ChartObjects(Worksheets(SheetName).ChartObjects.Count).Delete
Set xRgPic = Nothing
End Sub

Notas: En el código anterior, puede cambiar el contenido del cuerpo y la dirección de correo electrónico a su necesidad.

3. Después de insertar el código, presione F5 Para ejecutar este código, se abre un cuadro de diálogo para recordarle cómo seleccionar el rango de datos que desea insertar en el cuerpo del correo electrónico como imagen, consulte la captura de pantalla:

4. A continuación, haga clic en OK botón y una Mensaje: se muestra la ventana, el rango de datos seleccionado se ha insertado en el cuerpo como imagen, vea la captura de pantalla:

Notas: En el Mensaje: ventana, también puede cambiar el contenido del cuerpo y las direcciones de correo electrónico en los campos Para y Cc según lo necesite.

5. Por último, haz clic Enviar botón para enviar este correo electrónico.


Notas: Si necesita pegar varios rangos de diferentes hojas de trabajo, el siguiente código de VBA puede hacerle un favor:

Primero, debe seleccionar los múltiples rangos que desea insertar en el cuerpo del correo electrónico como imágenes y luego aplicar el siguiente código:

Código VBA: pegue múltiples rangos de celdas en el cuerpo del correo electrónico como imagen:

Sub sendMail()
    Dim TempFilePath As String
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xHTMLBody As String
    Dim xRg As Range
    Dim xSheet As Worksheet
    Dim xAcSheet As Worksheet
    Dim xFileName As String
    Dim xSrc As String
    On Error Resume Next
    TempFilePath = Environ$("temp") & "\RangePic\"
    If Len(VBA.Dir(TempFilePath, vbDirectory)) = False Then
      VBA.MkDir TempFilePath
    End If
    Set xAcSheet = Application.ActiveSheet
    For Each xSheet In Application.Worksheets
        xSheet.Activate
        Set xRg = xSheet.Application.Selection
        If xRg.Cells.Count > 1 Then
            Call createJpg(xSheet.Name, xRg.Address, "DashboardFile" & VBA.Trim(VBA.Str(xSheet.Index)))
        End If
    Next
    xAcSheet.Activate
    With Application
        .Calculation = xlManual
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    Set xOutApp = CreateObject("outlook.application")
    Set xOutMail = xOutApp.CreateItem(olMailItem)
    xSrc = ""
    xFileName = Dir(TempFilePath & "*.*")
    Do While xFileName <> ""
        xSrc = xSrc + VBA.vbCrLf + "<img src='cid:" + xFileName + "'><br>"
        xFileName = Dir
        If xFileName = "" Then Exit Do
    Loop
    xHTMLBody = "<span LANG=EN>" _
                & "<p class=style2><span LANG=EN><font FACE=Calibri SIZE=3>" _
                & "Hello, this is the data range that you want:<br> " _
                & "<br>" _
                & xSrc _
                & "<br>Best Regards!</font></span>"
    With xOutMail
        .Subject = ""
        .HTMLBody = xHTMLBody
        xFileName = Dir(TempFilePath & "*.*")
        Do While xFileName <> ""
            .Attachments.Add TempFilePath & xFileName, olByValue
            xFileName = Dir
        If xFileName = "" Then Exit Do
        Loop
        .To = " "
        .Cc = " "
       .Display
    End With
    If VBA.Dir(TempFilePath & "*.*") <> "" Then
        VBA.Kill TempFilePath & "*.*"
    End If
End Sub
Sub createJpg(SheetName As String, xRgAddrss As String, nameFile As String)
    Dim xRgPic As Range
    ThisWorkbook.Activate
    Worksheets(SheetName).Activate
    Set xRgPic = ThisWorkbook.Worksheets(SheetName).Range(xRgAddrss)
    xRgPic.CopyPicture
    With ThisWorkbook.Worksheets(SheetName).ChartObjects.Add(xRgPic.Left, xRgPic.Top, xRgPic.Width, xRgPic.Height)
        .Activate
        .Chart.Paste
        .Chart.Export Environ$("temp") & "\RangePic\" & nameFile & ".jpg", "JPG"
    End With
    Worksheets(SheetName).ChartObjects(Worksheets(SheetName).ChartObjects.Count).Delete
Set xRgPic = Nothing
End Sub


Excel herramientas de productividad

Kutools para Excel - La mejor herramienta de productividad de Office

  • Trae las características avanzadas y potentes de 300 a Excel, que le permiten hacer más inteligente, más rápido y mejor.
  • Ya no es necesario memorizar fórmulas y códigos de VBA, dale un descanso a tu cerebro de ahora en adelante.
  • Conviértase en un experto en Excel en minutos 3. Las operaciones complicadas y repetidas se pueden realizar en segundos.
  • Reduzca miles de operaciones de teclado y mouse todos los días, despídase ahora de las enfermedades profesionales.
  • 110,000 personas altamente efectivas y 300 + elección de compañías de renombre mundial.
  • 60-day completo de prueba gratuita de características. Garantías de devolución del dinero de 60-day. 2 años de actualización y soporte gratis.

Pestaña de Office: trae la interfaz de pestañas a Office, facilita mucho su trabajo.

  • Habilite la edición y lectura con pestañas en Word, Excel, PowerPoint, Publisher, Access, Visio y Project.
  • Abra y cree varios documentos en nuevas pestañas de la misma ventana, en lugar de en nuevas ventanas.
  • ¡Aumenta tu productividad en un 50% y reduce cientos de clics de ratón por ti todos los días!
Say something here...
symbols left.
You are guest ( Sign Up? )
or post as a guest, but your post won't be published automatically.
Loading comment... The comment will be refreshed after 00:00.
  • To post as a guest, your comment is unpublished.
    greg horton · 5 months ago
    This is awesome, I love it! Quick question. I see that it is adding a border to the image. Is there a way to generate without a border? Thanks in advance!
    • To post as a guest, your comment is unpublished.
      Ian Wildman · 4 months ago
      I'd love to know how to paste without generating a border as well. This code is awesome, super intuitive and straightforward. Thank you!
  • To post as a guest, your comment is unpublished.
    Piotrek · 1 years ago
    wyrzuca mi błąd w linijce "Set xOutMail = xOutApp.CreateItem(olMailItem)" olMailItem - nie zdefiniowana
    oraz ".Attachments.Add TempFilePath & "DashboardFile.jpg", olByValue" olByValue - nie zdefiniowana