Note: The other languages of the website are Google-translated. Back to English
Inicie sesión Regístrese

¿Cómo enviar un gráfico específico en un correo electrónico con vba en Excel?

Es posible que sepa cómo enviar un correo electrónico a través de Outlook en Excel con código VBA. Sin embargo, ¿sabe cómo adjuntar un gráfico específico en una determinada hoja de trabajo en el cuerpo del correo electrónico? Este artículo le mostrará el método para resolver este problema.

Envíe un gráfico específico en un correo electrónico en Excel con código VBA

Envíe un gráfico específico en un correo electrónico en Excel con código VBA

Haga lo siguiente para enviar un gráfico específico en un correo electrónico con código VBA en Excel.

1. En la hoja de trabajo que contiene el gráfico que desea adjuntar en el cuerpo del correo electrónico, presione el otro + F11 teclas para abrir el Microsoft Visual Basic para aplicaciones ventana.

2. En el Microsoft Visual Basic para aplicaciones ventana, haga clic en recuadro > Módulo. Luego, copie el código VBA a continuación en la ventana Código.

Código VBA: envíe un gráfico específico en un correo electrónico en Excel

Sub mailHTMLsend()
'Updated by Extendoffice 2018/3/5
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xStartMsg As String
    Dim xEndMsg As String
    Dim xChartName As String
    Dim xChartPath As String
    Dim xPath As String
    Dim xChart As ChartObject
    On Error Resume Next
    xChartName = Application.InputBox("Please enter the chart name:", "KuTools for Excel", , , , , , 2)
    If xChartName = "" Then Exit Sub
    Set xChart = Sheets("Sheet1").ChartObjects(xChartName) 'Change "Sheet1" to your worksheet name
    If xChart Is Nothing Then Exit Sub
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    xStartMsg = "<font size='5' color='black'> Good Day," & "<br> <br>" & "Please find the chart below: " & "<br> <br> </font>"
    xEndMsg = "<font size='4' color='black'> Many Thanks," & "<br> <br> </font>"
    xChartPath = Application.ActiveWorkbook.Path & "\" & Environ("USERNAME") & VBA.Format(VBA.Now(), "DD_MM_YY_HH_MM_SS") & ".bmp"
    xPath = "<p align='Left'><img src=" & "cid:" & Mid(xChartPath, InStrRev(xChartPath, "\") + 1) & """  width=700 height=500 > <br> <br>"
    xChart.Chart.Export xChartPath
    With xOutMail
        .To = "xrr@163.com"
        .Subject = "Add Chart in outlook mail body"
        .Attachments.Add xChartPath
        .HTMLBody = xStartMsg & xPath & xEndMsg
        .Display
    End With
    Kill xChartPath
    Set xOutMail = Nothing
    Set xOutApp = Nothing
End Sub

Nota:: En el código, cambie la dirección de correo electrónico del destinatario y el asunto del correo electrónico en la línea .To = "xrr@163.com" y la línea .Subject = "Agregar gráfico en el cuerpo del correo de Outlook" , Sheet1 es la hoja que contiene el gráfico que desea enviar, cámbielo por el suyo.

3. presione el F5 clave para ejecutar el código. En la apertura Kutools for Excel cuadro de diálogo, ingrese el nombre del gráfico que adjuntará en el cuerpo del correo electrónico y luego haga clic en el OK botón. Ver captura de pantalla:

Luego, se crea un correo electrónico automáticamente con el gráfico especificado que se muestra en el cuerpo del correo electrónico como se muestra a continuación. Haga clic en el botón Enviar para enviar este correo electrónico.

Artículos relacionados:

 

 

 

Las mejores herramientas de productividad de oficina

Kutools para Excel resuelve la mayoría de sus problemas y aumenta su productividad en un 80%

  • Reutilizar: Inserte rápidamente fórmulas complejas, gráficos y cualquier cosa que hayas usado antes; Cifrar celdas con contraseña; Crear lista de distribución y enviar correos electrónicos ...
  • Barra de súper fórmula (edite fácilmente varias líneas de texto y fórmulas); Diseño de lectura (leer y editar fácilmente un gran número de celdas); Pegar en rango filtrado...
  • Combinar celdas / filas / columnas sin perder datos; Contenido de celdas divididas; Combinar filas / columnas duplicadas... Prevenir celdas duplicadas; Comparar rangos...
  • Seleccione Duplicado o Único Filas; Seleccionar filas en blanco (todas las celdas están vacías); Super Find y Fuzzy Find en muchos libros de trabajo; Selección aleatoria ...
  • Copia exacta Varias celdas sin cambiar la referencia de la fórmula; Crear referencias automáticamente a varias hojas; Insertar viñetas, Casillas de verificación y más ...
  • Extraer texto, Agregar texto, Eliminar por posición, Quitar espacio; Crear e imprimir subtotales de paginación; Convertir entre contenido de celdas y comentarios...
  • Súper filtro (guardar y aplicar esquemas de filtros a otras hojas); Orden avanzado por mes / semana / día, frecuencia y más; Filtro especial en negrita, cursiva ...
  • Combinar libros y hojas de trabajo; Combinar tablas basadas en columnas clave; Dividir datos en varias hojas; Conversión por lotes de xls, xlsx y PDF...
  • Más de 300 potentes funciones. Compatible con Office/Excel 2007-2021 y 365. Compatible con todos los idiomas. Fácil implementación en su empresa u organización. Funciones completas Prueba gratuita de 30 días. Garantía de devolución de dinero de 60 días.
pestaña kte 201905

Office Tab lleva la interfaz con pestañas a Office y hace que su trabajo sea mucho más fácil

  • 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 su productividad en un 50% y reduce cientos de clics del mouse todos los días!
officetab parte inferior

 

 

Comentarios (13)
Aún no hay calificaciones. ¡Sé el primero en calificar!
Leigh
Leigh
Este comentario fue minimizado por el moderador en el sitio
cuando ingreso el nombre del gráfico, el correo no genera el cuadro de diálogo, simplemente se cierra, ¿alguna idea de lo que hice mal? he seguido cada paso
Responder
0
0
Borges
Borges     Leigh
Este comentario fue minimizado por el moderador en el sitio
El problema es que no podemos establecer nombres para objetos de gráficos como tablas. Necesitas pasar el ID entero para que funcione. Por ejemplo, si solo tiene 1 gráfico en la "Hoja 1", intente pasar el valor 1 cuando aparezca el cuadro de mensaje.

PD: lo siento por el mal inglés:]
Responder
0
0
Aarón Manqueo
Aarón Manqueo
Este comentario fue minimizado por el moderador en el sitio
hola como se puede enviar por correo, una tabla dinamica, y no un grafico
Responder
0
0
Nitin Sharma
Nitin Sharma
Este comentario fue minimizado por el moderador en el sitio
Hay un error en el código: "\") + 1) & "" ancho = 700 alto = 50 En el texto en negrita, el del medio debe ser una sola coma invertida

Responder
0
0
youssef
youssef
Este comentario fue minimizado por el moderador en el sitio
Incluye el gráfico como archivo adjunto. ¿Tiene alguna idea de cómo incluirlo como una imagen en el cuerpo del correo? Gracias, Youssef
Responder
0
0
J
J     youssef
Este comentario fue minimizado por el moderador en el sitio
Mismo problema, alguna solución?
Responder
0
0
cristal
cristal     J
Este comentario fue minimizado por el moderador en el sitio
Hola J,
El código ha sido actualizado. Por favor inténtalo. Lo siento por los inconvenientes ocasionados.


Sub mailHTMLsend()
'Updated by Extendoffice 2018/3/5
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xStartMsg As String
    Dim xEndMsg As String
    Dim xChartName As String
    Dim xChartPath As String
    Dim xPath As String
    Dim xChart As ChartObject
    On Error Resume Next
    xChartName = Application.InputBox("Please enter the chart name:", "KuTools for Excel", , , , , , 2)
    If xChartName = "" Then Exit Sub
    Set xChart = Sheets("Sheet1").ChartObjects(xChartName) 'Change "Sheet1" to your worksheet name
    If xChart Is Nothing Then Exit Sub
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    xStartMsg = "<font size='5' color='black'> Good Day," & "<br> <br>" & "Please find the chart below: " & "<br> <br> </font>"
    xEndMsg = "<font size='4' color='black'> Many Thanks," & "<br> <br> </font>"
    xChartPath = Application.ActiveWorkbook.Path & "\" & Environ("USERNAME") & VBA.Format(VBA.Now(), "DD_MM_YY_HH_MM_SS") & ".bmp"
    xPath = "<p align='Left'><img src="/%20&%20"cid:" & Mid(xChartPath, InStrRev(xChartPath, "\") + 1) & """  width=700 height=500 > <br> <br>"
    xChart.Chart.Export xChartPath
    With xOutMail
        .To = "xrr@163.com"
        .Subject = "Add Chart in outlook mail body"
        .Attachments.Add xChartPath
        .HTMLBody = xStartMsg & xPath & xEndMsg
        .Display
    End With
    Kill xChartPath
    Set xOutMail = Nothing
    Set xOutApp = Nothing
End Sub
Responder
Reportar
0
0
Cuba
Cuba     cristal
Este comentario fue minimizado por el moderador en el sitio
Hola,
mi nic sie nie załącza, czy coś tutaj należałoby wpisać jeszcze?
xPath = "co tutaj trzeba wprowadzić?"
Responder
0
0
cristal
cristal     Cuba
Este comentario fue minimizado por el moderador en el sitio
Hola Kuba,
Quite el / etiqueta en <img src="/.
El error es causado por el editor en el sitio.
Disculpen las molestias.
Responder
Reportar
0
0
Cuba
Cuba     cristal
Este comentario fue minimizado por el moderador en el sitio
cześć, pełny kod działa tylko do momentu podglądu komunikatu, przy wysyłce adresat otrzymuje błąd i wykresu nie widać ("Nie można wyświetlić połączonego obrazu. Plik mógł zostać przeniesiony lub usunięty albo zmieniono jego nazwę. Sprawdź czy łącze wskazuje poprawny plik i lokazlizację.") Czy z Was też tak ktoś miał czy tylko u mnie taki zonk? Prosze o pomoc, tutaj kod, który dotyczy wykresum już tak mało brakuje :)

Dim xChartName como cadena
Dim xChartPath como cadena
Atenuar xPath como cadena
Dim xChart como ChartObject
On Error Resume Next
Dim wydzialy como cadena
wydzialy = lista.Cells(3, 75)
xChartName = Application.InputBox(wydzialy, "KuTools for Excel", , , , , , 2) 'Wykres1 '"Ingrese el nombre del gráfico:"
Si xChartName = "" Entonces Salir de Sub
Establezca xChart = Sheets ("Wykresy"). ChartObjects (xChartName) 'Cambie "Sheet1" al nombre de su hoja de trabajo
Si xChart no es nada, salga de Sub
xChartPath = Application.ActiveWorkbook.Path & "\" & Environ("NOMBRE DE USUARIO") & VBA.Format(VBA.Now(), "DD_MM_YY_HH_MM_SS") & ".svg" '.bmp '.svg '.svg ma lepsza jakość
xRuta = " "
xChart.Chart.Export xChartPath


Dim OutApp como objeto
Dim OutMail como objeto
Establecer OutApp = CreateObject("Outlook.Application")
Establecer OutMail = OutApp.CreateItem(0)
Con correo saliente
.Para = correos electrónicos (b)
.CC = correos electrónicos_dw(b)
.Asunto = "XXXX" ' - " & lista.Celdas(i, 66)
.Archivos adjuntos.Agregar xChartPath
.HTMLBody = "treść" & xPath

Establecer .SendUsingAccount = OutApp.Session.Accounts.Item(1)

.Monitor
End With
Matar xChartPath
Set OutMail = Nada
Set OutApp = Nada
0
0
cristal
cristal     Cuba
Este comentario fue minimizado por el moderador en el sitio
Hola Kuba,
El código ha sido actualizado. El destinatario puede ver el gráfico normalmente. Por favor inténtalo.
Nota:: En el código, cambie el "Gráfico 1" a su propio nombre de gráfico. Y especifique la dirección de correo electrónico en el campo Para.
Sub mailHTMLsend()
'Updated by Extendoffice 20221013
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xStartMsg As String
    Dim xEndMsg As String
    Dim xChartName 'As String
    Dim xChartPath As String
    Dim xPath As String
    Dim xChart As ChartObject
    On Error Resume Next
    xChartName = "Chart 1" 'The name of the chart in the current worksheet you want to send.
    If xChartName = "" Then Exit Sub
    Set xChart = Application.ActiveSheet.ChartObjects(xChartName)
    If xChart Is Nothing Then Exit Sub
    
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    
    xStartMsg = "<font size='5' color='black'> Good Day," & "<br> <br>" & "Please find the chart below: " & "<br> <br> </font>"
    xEndMsg = "<font size='4' color='black'> Many Thanks," & "<br> <br> </font>"
    xChartPath = Application.ActiveWorkbook.Path & "\" & Environ("USERNAME") & VBA.Format(VBA.Now(), "DD_MM_YY_HH_MM_SS") & ".bmp"
    
    xPath = "<p align='Left'><img src="/%20&%20"cid:" & Mid(xChartPath, InStrRev(xChartPath, "\") + 1) & """  width=700 height=500 > <br> <br>"
    
    xChart.Chart.Export xChartPath
    With xOutMail
        .To = "Email Address"
        .Subject = "Add Chart in outlook mail body"
        .Attachments.Add xChartPath
        .HTMLBody = xStartMsg & xPath & xEndMsg
        .Display
    End With
    Kill xChartPath
    Set xOutMail = Nothing
    Set xOutApp = Nothing
End Sub
Responder
Reportar
0
0
pavana chougule
pavana chougule
Este comentario fue minimizado por el moderador en el sitio
HOLA, quiero agregar espacio en el cuerpo del correo, qué palabra clave debo usar.
Responder
0
0
cristal
cristal     pavana chougule
Este comentario fue minimizado por el moderador en el sitio
Hola pavan chougule,
Las siguientes dos líneas en el código contienen el contenido del cuerpo del correo electrónico. Puede modificar manualmente el cuerpo del correo electrónico presionando la tecla de espacio en su teclado para agregar un espacio.
xStartMsg = "<font size='5' color='black'> Good Day," & "<br> <br>" & "Please find the chart below: " & "<br> <br> </font>"
xEndMsg = "<font size='4' color='black'> Many Thanks," & "<br> <br> </font>"
Responder
Reportar
0
0
No hay comentarios publicados aquí todavía
Deje sus comentarios
GUEST
Publicar como invitado
Iniciar sesión
×
Califica esta publicación:
Restablecer configuración
0   Personajes
Ubicaciones sugeridas

Seguinos

Copyright © 2009 - www.extendoffice.com. | Reservados todos los derechos. Energizado por ExtendOffice, | Mapa del Sitio
Microsoft y el logotipo de Office son marcas comerciales o marcas comerciales registradas de Microsoft Corporation en los Estados Unidos y / o en otros países.
Protegido por Sectigo SSL