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

¿Cómo guardar una hoja de trabajo como archivo PDF y enviarla por correo electrónico como archivo adjunto a través de Outlook?

En algunos casos, es posible que deba enviar una hoja de trabajo como archivo PDF a través de Outlook. Por lo general, debe guardar manualmente la hoja de trabajo como un archivo PDF, luego crear un nuevo correo electrónico con este archivo PDF como archivo adjunto en su Outlook y finalmente enviarlo. Lleva mucho tiempo lograrlo manualmente paso a paso. En este artículo, le mostraremos cómo guardar rápidamente una hoja de trabajo como un archivo PDF y enviarla automáticamente como un archivo adjunto a través de Outlook en Excel.

Guarde una hoja de trabajo como archivo PDF y envíela por correo electrónico como archivo adjunto con código VBA

Guarde una hoja de trabajo como archivo PDF y envíela por correo electrónico como archivo adjunto con código VBA

Puede ejecutar el siguiente código VBA para guardar automáticamente la hoja de trabajo activa como un archivo PDF y luego enviarla por correo electrónico como un archivo adjunto a través de Outlook. Haz lo siguiente.

1. Abra la hoja de trabajo que guardará como PDF y envíela, luego presione otro + F11 teclas simultáneamente para abrir el Microsoft Visual Basic para aplicaciones ventana.

2. En el Microsoft Visual Basic para aplicaciones ventana, haga clic recuadro > Módulo. Luego copie y pegue el siguiente código VBA en el Código ventana. Ver captura de pantalla:

Código VBA: guarde una hoja de trabajo como archivo PDF y envíela por correo electrónico como archivo adjunto

Sub Saveaspdfandsend()
Dim xSht As Worksheet
Dim xFileDlg As FileDialog
Dim xFolder As String
Dim xYesorNo As Integer
Dim xOutlookObj As Object
Dim xEmailObj As Object
Dim xUsedRng As Range

Set xSht = ActiveSheet
Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

If xFileDlg.Show = True Then
   xFolder = xFileDlg.SelectedItems(1)
Else
   MsgBox "You must specify a folder to save the PDF into." & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Must Specify Destination Folder"
   Exit Sub
End If
xFolder = xFolder + "\" + xSht.Name + ".pdf"

'Check if file already exist
If Len(Dir(xFolder)) > 0 Then
    xYesorNo = MsgBox(xFolder & " already exists." & vbCrLf & vbCrLf & "Do you want to overwrite it?", _
                      vbYesNo + vbQuestion, "File Exists")
    On Error Resume Next
    If xYesorNo = vbYes Then
        Kill xFolder
    Else
        MsgBox "if you don't overwrite the existing PDF, I can't continue." _
                    & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Exiting Macro"
        Exit Sub
    End If
    If Err.Number <> 0 Then
        MsgBox "Unable to delete existing file.  Please make sure the file is not open or write protected." _
                    & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Unable to Delete File"
        Exit Sub
    End If
End If

Set xUsedRng = xSht.UsedRange
If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Then
    'Save as PDF file 
    xSht.ExportAsFixedFormat Type:=xlTypePDF, Filename:=xFolder, Quality:=xlQualityStandard
    
    'Create Outlook email 
    Set xOutlookObj = CreateObject("Outlook.Application")
    Set xEmailObj = xOutlookObj.CreateItem(0)
    With xEmailObj
        .Display
        .To = ""
        .CC = ""
        .Subject = xSht.Name + ".pdf"
        .Attachments.Add xFolder
        If DisplayEmail = False Then
            '.Send
        End If
    End With
Else
  MsgBox "The active worksheet cannot be blank"
  Exit Sub
End If
End Sub

3. presione el F5 clave para ejecutar el código. En el Búsqueda de cuadro de diálogo, seleccione una carpeta para guardar este archivo PDF y luego haga clic en el OK

Notas:

1. Ahora la hoja de trabajo activa se guarda como archivo PDF. Y el archivo PDF se nombra con el nombre de la hoja de trabajo.
2. Si la hoja de trabajo activa está en blanco, aparecerá un cuadro de diálogo como la siguiente captura de pantalla que se muestra después de hacer clic en el OK

4. Ahora se crea un nuevo correo electrónico de Outlook y puede ver que el archivo PDF aparece como un archivo adjunto en el archivo Adjunto. Ver captura de pantalla:

5. Redacte este correo electrónico y envíelo.
6. Este código solo está disponible cuando usa Outlook como su programa de correo.

Guarde fácilmente una hoja de trabajo o varias hojas de trabajo como archivos PDF separados a la vez:

Programas de Libro de trabajo dividido utilidad de Kutools for Excel puede ayudarlo a guardar fácilmente una hoja de trabajo o varias hojas de trabajo como archivos PDF separados a la vez, como se muestra en la siguiente demostración. ¡Descárgalo y pruébalo ahora! (30sendero libre de un día)

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 (62)
5 clasificado de 5 · 1 calificaciones
Michael
Michael
Este comentario fue minimizado por el moderador en el sitio
Esto funciona muy bien para mí, pero ¿hay alguna forma de seleccionar una ubicación de carpeta automáticamente en lugar de seleccionarla manualmente? Espero hacer esto para 40 hojas a la vez.
Responder
0
0
Hugh
Hugh     Michael
Este comentario fue minimizado por el moderador en el sitio
¡También espero ver una respuesta para este problema! ¡Gracias por la ayuda!
Responder
0
0
Darren
Darren
Este comentario fue minimizado por el moderador en el sitio
Intenté pegar esto en un nuevo módulo y obtengo un error de compilación: sub o función no definida. Por favor ayuda.
Responder
0
0
cristal
cristal     Darren
Este comentario fue minimizado por el moderador en el sitio
Estimado cliente,
¿Qué versión de Office usas?
Responder
Reportar
0
0
Nakia
Nakia     cristal
Este comentario fue minimizado por el moderador en el sitio
Office 360
Responder
0
0
Bill
Bill     Darren
Este comentario fue minimizado por el moderador en el sitio
Mismo problema
Responder
0
0
miguel charry
miguel charry
Este comentario fue minimizado por el moderador en el sitio
¿Cómo editaría el script VBA anterior para que agregue una marca de fecha y hora al nombre del archivo de esa manera no sobrescriba lo que ya está guardado?
Responder
Reportar
0
0
cristal
cristal     miguel charry
Este comentario fue minimizado por el moderador en el sitio
Querido Michael,
Ejecute el siguiente código VBA para resolver el problema.

Sub Guardar como pdf y enviar ()
Dim xSht como hoja de trabajo
Dim xFileDlg como FileDialog
Dim xFolder como cadena
Dim xSí o No como entero
Dim xOutlookObj como objeto
Dim xEmailObj como objeto
Dim xUsedRng como rango
Dim xStr como cadena

Establecer xSht = hoja activa
Establecer xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

Si xFileDlg.Show = Verdadero Entonces
xFolder = xFileDlg.SelectedItems(1)
otro
MsgBox "Debe especificar una carpeta para guardar el PDF". & vbCrLf & vbCrLf & "Presione OK para salir de esta macro.", vbCritical, "Debe especificar la carpeta de destino"
Exit Sub
Si terminar
xStr = Formato(Ahora(), "aaaa-mm-dd-hh-mm-ss")
xFolder = xFolder + "\" + xSht.Name + "-" + xStr + ".pdf"

'Comprobar si el archivo ya existe
Si Len(Dir(xFolder)) > 0 Entonces
xSí o No = MsgBox(xFolder & " ya existe." & vbCrLf & vbCrLf & "¿Desea sobrescribirlo?", _
vbSíNo + vbPregunta, "El archivo existe")
On Error Resume Next
Si xSí o No = vbSí Entonces
Matar xFolder
otro
MsgBox "si no sobrescribe el PDF existente, no puedo continuar". _
& vbCrLf & vbCrLf & "Presione OK para salir de esta macro.", vbCritical, "Saliendo de la macro"
Exit Sub
Si terminar
Si Err.Number <> 0 Entonces
MsgBox "No se pudo eliminar el archivo existente. Asegúrese de que el archivo no esté abierto o protegido contra escritura". _
& vbCrLf & vbCrLf & "Presione OK para salir de esta macro.", vbCritical, "No se pudo eliminar el archivo"
Exit Sub
Si terminar
Si terminar

Establecer xUsedRng = xSht.UsedRange
Si Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Entonces
'Guardar como archivo PDF
xSht.ExportAsFixedFormat Tipo:=xlTypePDF, Nombre de archivo:=xFolder, Calidad:=xlQualityStandard

'Crear correo electrónico de Outlook
Establecer xOutlookObj = CreateObject("Outlook.Aplicación")
Establecer xEmailObj = xOutlookObj.CreateItem(0)
Con xEmailObj
.Monitor
.Para = ""
.CC = ""
.Asunto = xSht.Nombre + "-" + xStr + ".pdf"
.Archivos adjuntos.Agregar xFolder
Si DisplayEmail = False Entonces
'.Enviar
Si terminar
End With
otro
MsgBox "La hoja de trabajo activa no puede estar en blanco"
Exit Sub
Si terminar
End Sub
Responder
Reportar
0
0
Parag Somani
Parag Somani     cristal
Este comentario fue minimizado por el moderador en el sitio
Hola Crystal,

Es realmente genial y funciona perfectamente para mí. Necesito más ayuda para agregar:

1. en "Para" quiero dar un enlace a una celda particular de la hoja activa de la misma manera en CC y en BCC me gustaría agregar un enlace de hoja activa
2. en el cuerpo del correo electrónico necesito especificar algún texto estándar.

Seré muy completo contigo por tu ayuda.

Muchas Gracias
Parag
Responder
0
0
cristal
cristal     Parag Somani
Este comentario fue minimizado por el moderador en el sitio
Hola Parag Somani,
El siguiente código de VBA puede ayudarlo. Cambie los campos .Para, .CC, .BCC y .Body según sus necesidades.

Sub Guardar como pdf y enviar ()
Dim xSht como hoja de trabajo
Dim xFileDlg como FileDialog
Dim xFolder como cadena
Dim xSí o No como entero
Dim xOutlookObj como objeto
Dim xEmailObj como objeto
Dim xUsedRng como rango
Dim xStr como cadena

Establecer xSht = hoja activa
Establecer xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

Si xFileDlg.Show = Verdadero Entonces
xFolder = xFileDlg.SelectedItems(1)
otro
MsgBox "Debe especificar una carpeta para guardar el PDF". & vbCrLf & vbCrLf & "Presione OK para salir de esta macro.", vbCritical, "Debe especificar la carpeta de destino"
Exit Sub
Si terminar
xStr = Formato(Ahora(), "aaaa-mm-dd-hh-mm-ss")
xFolder = xFolder + "\" + xSht.Name + "-" + xStr + ".pdf"

'Comprobar si el archivo ya existe
Si Len(Dir(xFolder)) > 0 Entonces
xSí o No = MsgBox(xFolder & " ya existe." & vbCrLf & vbCrLf & "¿Desea sobrescribirlo?", _
vbSíNo + vbPregunta, "El archivo existe")
On Error Resume Next
Si xSí o No = vbSí Entonces
Matar xFolder
otro
MsgBox "si no sobrescribe el PDF existente, no puedo continuar". _
& vbCrLf & vbCrLf & "Presione OK para salir de esta macro.", vbCritical, "Saliendo de la macro"
Exit Sub
Si terminar
Si Err.Number <> 0 Entonces
MsgBox "No se pudo eliminar el archivo existente. Asegúrese de que el archivo no esté abierto o protegido contra escritura". _
& vbCrLf & vbCrLf & "Presione OK para salir de esta macro.", vbCritical, "No se pudo eliminar el archivo"
Exit Sub
Si terminar
Si terminar

Establecer xUsedRng = xSht.UsedRange
Si Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Entonces
'Guardar como archivo PDF
xSht.ExportAsFixedFormat Tipo:=xlTypePDF, Nombre de archivo:=xFolder, Calidad:=xlQualityStandard

'Crear correo electrónico de Outlook
Establecer xOutlookObj = CreateObject("Outlook.Aplicación")
Establecer xEmailObj = xOutlookObj.CreateItem(0)
Con xEmailObj
.Monitor
.Hasta = Rango("A8")
.CC = Rango("A9")
.BCC = Rango ("A10")
.Asunto = xSht.Nombre + "-" + xStr + ".pdf"
.Cuerpo = "Querido" _
& vbNuevaLínea & vbNuevaLínea & _
"Este es un correo electrónico de prueba" & _
"enviando en excel"
.Archivos adjuntos.Agregar xFolder
Si DisplayEmail = False Entonces
'.Enviar
Si terminar
End With
otro
MsgBox "La hoja de trabajo activa no puede estar en blanco"
Exit Sub
Si terminar
End Sub
Responder
Reportar
0
0
Mehul
Mehul     cristal
Este comentario fue minimizado por el moderador en el sitio
He estado tratando de usar el Rango para "Para", "CC", simplemente no recoge los valores de la celda designada. ¿Puedes ayudarme con esto?
Gracias,
Mehul
Responder
0
0
Parag Somani
Parag Somani     cristal
Este comentario fue minimizado por el moderador en el sitio
Hola Crystal,

Es realmente genial y funciona perfectamente para mí. Necesito más ayuda para agregar:

1. en "Para" quiero dar un enlace a una celda particular de la hoja activa de la misma manera en CC y en BCC me gustaría agregar un enlace de hoja activa
2. en el cuerpo del correo electrónico necesito especificar algún texto estándar.

Seré muy completo contigo por tu ayuda.

Muchas Gracias
Parag
Responder
0
0
Parag
Parag     cristal
Este comentario fue minimizado por el moderador en el sitio
Hola Crystal,

Es realmente genial y funciona perfectamente para mí. Necesito más ayuda para agregar:

1. en "Para" quiero dar un enlace a una celda particular de la hoja activa de la misma manera en CC y en BCC me gustaría agregar un enlace de hoja activa
2. en el cuerpo del correo electrónico necesito especificar algún texto estándar.

Seré muy completo contigo por tu ayuda.

Muchas Gracias
Parag
Responder
Reportar
0
0
Armin
Armin
Este comentario fue minimizado por el moderador en el sitio
¿Cómo puedo agregar, por ejemplo, la hoja 2 del libro de trabajo como un pdf?
Responder
0
0
cristal
cristal     Armin
Este comentario fue minimizado por el moderador en el sitio
Hola Armin,
Primero debe abrir la Hoja 2 en su libro de trabajo y luego ejecutar el código VBA con los pasos anteriores para bajarlo.
Responder
Reportar
0
0
Tom H
Tom H
Este comentario fue minimizado por el moderador en el sitio
¿Cómo editaría el script de VBA anterior para que el nombre del archivo se guarde como una celda específica seleccionada dentro de la hoja actual, por ejemplo, la celda A1?
Responder
0
0
cristal
cristal     Tom H
Este comentario fue minimizado por el moderador en el sitio
Hola Tom.
Lo siento, no puedo ayudar con esto.
Bienvenido a publicar cualquier pregunta en nuestro foro: https://www.extendoffice.com/forum.html
Obtendrá más soporte de Excel de nuestro profesional de Excel u otros fanáticos de Excel.
Responder
Reportar
0
0
james
james
Este comentario fue minimizado por el moderador en el sitio
Hola, ¿cómo puedo guardar y enviar el pdf con el nombre del libro de trabajo con el código VBA actual? ¿Qué uso en lugar de xSht.Name?
Responder
0
0
cristal
cristal     james
Este comentario fue minimizado por el moderador en el sitio
Hola James,
¿Desea enviar la hoja de trabajo activa como pdf y nombrarla como el nombre del libro de trabajo?
Responder
Reportar
0
0
Ranga
Ranga
Este comentario fue minimizado por el moderador en el sitio
Gracias funciona
Responder
0
0
Jason
Jason
Este comentario fue minimizado por el moderador en el sitio
¿Cómo puedo hacer que elimine el pdf guardado después de enviarlo por correo electrónico?
Responder
0
0
cristal
cristal     Jason
Este comentario fue minimizado por el moderador en el sitio
Hola Jason,
Lo siento, no puedo ayudarte con eso todavía. Debe eliminarlo manualmente después de enviarlo por correo electrónico.
Responder
Reportar
0
0
Odd-Inge
Odd-Inge
Este comentario fue minimizado por el moderador en el sitio
Hola,

¿Es posible encontrar el nombre de pdf desde una celda? Ex. Celda H4


Y en la celda H4, quiero que se recolecte de tres celdas diferentes. es posible?
Responder
0
0
Taylor
Taylor     Odd-Inge
Este comentario fue minimizado por el moderador en el sitio
Esto es posible. Cree variables separadas para contener el valor de las celdas y luego use esas variables al configurar xFolder.
Usé el valor de una celda en mi hoja más la fecha de hoy. Sin embargo, podría hacer fácilmente múltiples valores de celda.

Esto es lo que agregué:
Dim xMemberName como cadena
Dim xFileDate como cadena

xMiembroNombre = Rango("H3").Valor
xFileDate = Formato (Ahora, "mm-dd")

xFolder = xFolder + "\" xMemberName + xFileDate + ".pdf"
Responder
0
0
Sora
Sora     Taylor
Este comentario fue minimizado por el moderador en el sitio
Recibo un error cuando intento esto, ¿en qué parte del código debo colocar esto?
Responder
0
0
Kishore
Kishore
Este comentario fue minimizado por el moderador en el sitio
Hola Crystal,



Es realmente genial y funciona perfectamente para mí. Necesito más ayuda para agregar:

1. en "Cuerpo" quiero dar un enlace a una celda particular de la hoja Activa. Además Me gustaría poner en negrita el texto.

Muchas Gracias

saludos

Kishore Kumar
Responder
Reportar
0
0
cristal
cristal     Kishore
Este comentario fue minimizado por el moderador en el sitio
Hola,

¿Quiere agregar el valor de la celda automáticamente al cuerpo del correo y ponerlo en negrita? Supongamos que agrega el valor de C4 al cuerpo del correo. Por favor, aplique el siguiente código.

Sub Guardar como pdf y enviar ()

Dim xSht como hoja de trabajo

Dim xFileDlg como FileDialog

Dim xFolder como cadena

Dim xSí o No como entero

Dim xOutlookObj como objeto

Dim xEmailObj como objeto

Dim xUsedRng como rango



Establecer xSht = hoja activa

Establecer xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)



Si xFileDlg.Show = Verdadero Entonces

xFolder = xFileDlg.SelectedItems(1)

otro

MsgBox "Debe especificar una carpeta para guardar el PDF". & vbCrLf & vbCrLf & "Presione OK para salir de esta macro.", vbCritical, "Debe especificar la carpeta de destino"

Exit Sub

Si terminar

xFolder = xFolder + "\" + xSht.Nombre + ".pdf"



'Comprobar si el archivo ya existe

Si Len(Dir(xFolder)) > 0 Entonces

xSí o No = MsgBox(xFolder & " ya existe." & vbCrLf & vbCrLf & "¿Desea sobrescribirlo?", _

vbSíNo + vbPregunta, "El archivo existe")

On Error Resume Next

Si xSí o No = vbSí Entonces

Matar xFolder

otro

MsgBox "si no sobrescribe el PDF existente, no puedo continuar". _

& vbCrLf & vbCrLf & "Presione OK para salir de esta macro.", vbCritical, "Saliendo de la macro"

Exit Sub

Si terminar

Si Err.Number <> 0 Entonces

MsgBox "No se pudo eliminar el archivo existente. Asegúrese de que el archivo no esté abierto o protegido contra escritura". _

& vbCrLf & vbCrLf & "Presione OK para salir de esta macro.", vbCritical, "No se pudo eliminar el archivo"

Exit Sub

Si terminar

Si terminar



Establecer xUsedRng = xSht.UsedRange

Si Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Entonces

'Guardar como archivo PDF

xSht.ExportAsFixedFormat Tipo:=xlTypePDF, Nombre de archivo:=xFolder, Calidad:=xlQualityStandard



'Crear correo electrónico de Outlook

Establecer xOutlookObj = CreateObject("Outlook.Aplicación")

Establecer xEmailObj = xOutlookObj.CreateItem(0)

Con xEmailObj

.Monitor

.Para = ""

.CC = ""

.Asunto = xSht.Nombre + ".pdf"

.Archivos adjuntos.Agregar xFolder

.HTMLBody = "
" & Rango("C4") & .HTMLBody

Si DisplayEmail = False Entonces

'.Enviar

Si terminar

End With

otro

MsgBox "La hoja de trabajo activa no puede estar en blanco"

Exit Sub

Si terminar

End Sub
Responder
Reportar
0
0
Geoff
Geoff
Este comentario fue minimizado por el moderador en el sitio
Si quisiera que se guardara automáticamente en una carpeta específica cada vez (eliminando la necesidad de que el usuario elija la carpeta), ¿cómo lo haría?
Ex. C: Facturas/América del Norte/Clientes
Ayuda es muy apreciada.
Responder
0
0
cristal
cristal     Geoff
Este comentario fue minimizado por el moderador en el sitio
Hola geoff
¿Quiere decir guardar la hoja de trabajo como un archivo pdf y guardarla en una carpeta específica sin enviarla?
Responder
Reportar
0
0
Jeremy
Jeremy     cristal
Este comentario fue minimizado por el moderador en el sitio
Creo que Geoff significa poder especificar una carpeta específica en el código en el que se guarda el pdf cada vez en lugar de tener que seleccionar la ubicación manualmente. Luego, el pdf se envía por correo electrónico desde esa carpeta específica.
Responder
0
0
cristal
cristal     Jeremy
Este comentario fue minimizado por el moderador en el sitio
Gracias Jeremy.
Responder
Reportar
0
0
cristal
cristal     Geoff
Este comentario fue minimizado por el moderador en el sitio
Hola Geoff, si desea guardar automáticamente el archivo pdf en una carpeta específica en lugar de seleccionar la ubicación manualmente, intente con el siguiente código. No olvide cambiar la ruta de la carpeta en el código.
Sub Guardar como PDF y enviar ()
Dim xSht como hoja de trabajo
Dim xFileDlg como FileDialog
Dim xFolder como cadena
Dim xSí o No como entero
Dim xOutlookObj como objeto
Dim xEmailObj como objeto
Dim xUsedRng como rango
Atenuar xPath como cadena
Establecer xSht = hoja activa
xRuta = "C:\Usuarios\Win10x64Test\Escritorio\hoja de trabajo a pdf" 'aquí "hoja de trabajo a pdf" es la carpeta de destino para guardar los archivos pdf
xFolder = xPath + "\" + xSht.Nombre + ".pdf"
Si Len(Dir(xFolder)) > 0 Entonces
xSí o No = MsgBox(xFolder & " ya existe." & vbCrLf & vbCrLf & "¿Desea sobrescribirlo?", _
vbSíNo + vbPregunta, "El archivo existe")
On Error Resume Next
Si xSí o No = vbSí Entonces
Matar xFolder
otro
MsgBox "si no sobrescribe el PDF existente, no puedo continuar". _
& vbCrLf & vbCrLf & "Presione OK para salir de esta macro.", vbCritical, "Saliendo de la macro"
Exit Sub
Si terminar
Si Err.Number <> 0 Entonces
MsgBox "No se pudo eliminar el archivo existente. Asegúrese de que el archivo no esté abierto o protegido contra escritura". _
& vbCrLf & vbCrLf & "Presione OK para salir de esta macro.", vbCritical, "No se pudo eliminar el archivo"
Exit Sub
Si terminar
Si terminar

Establecer xUsedRng = xSht.UsedRange
Si Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Entonces
'Guardar como archivo PDF
xSht.ExportAsFixedFormat Tipo:=xlTypePDF, Nombre de archivo:=xFolder, Calidad:=xlQualityStandard

'Crear correo electrónico de Outlook
Establecer xOutlookObj = CreateObject("Outlook.Aplicación")
Establecer xEmailObj = xOutlookObj.CreateItem(0)
Con xEmailObj
.Monitor
.Para = ""
.CC = ""
.Asunto = xSht.Nombre + ".pdf"
.Archivos adjuntos.Agregar xFolder
Si DisplayEmail = False Entonces
'.Enviar
Si terminar
End With
otro
MsgBox "La hoja de trabajo activa no puede estar en blanco"
Exit Sub
Si terminar
End Sub
Responder
Reportar
0
0
Alison
Alison
Este comentario fue minimizado por el moderador en el sitio
Este código funciona muy bien, excepto que quiero que la hoja de trabajo se guarde como nombre de hoja + fecha (es decir, Hoja1 1 de octubre de 2020); en el escritorio del usuario (esto será utilizado por varias personas y sus rutas pueden variar ligeramente). Si es posible, también quiero incrustar un .jpg en el cuerpo... el JPG se encuentra dentro de la hoja de trabajo (fuera del área de impresión) y la imagen se almacena en un servidor compartido... aunque la ruta al servidor varía según usuario (para la mayoría es una unidad "T" para algunos una unidad "U")
¿Se puede hacer esto? por favor y gracias un millón de veces.
Responder
0
0
Deepak
Deepak
Este comentario fue minimizado por el moderador en el sitio

Hola, está funcionando muy bien, gracias por compartir, solo necesito una ayuda.
Si quiero guardar un archivo PDF con un nombre personalizado (opción para escribir el nombre del archivo en el cuadro de diálogo Guardar como), como usuario use esta opción en la plantilla de formulario donde los formularios se guardan como PDF con un nombre único.
Responder
Reportar
0
0
cristal
cristal     Deepak
Este comentario fue minimizado por el moderador en el sitio
Hola, intente con el siguiente código VBA. Después de ejecutar el código, seleccione una carpeta para guardar el archivo PDF, luego aparecerá un cuadro de diálogo para que ingrese el nombre del archivo. Sub Guardar como pdf y enviar ()
'Actualizado por Extendoffice 20210209
Dim xSht como hoja de trabajo
Dim xFileDlg como FileDialog
Dim xFolder como cadena
Dim xSí o No como entero
Dim xOutlookObj como objeto
Dim xEmailObj como objeto
Dim xUsedRng como rango
Dim xStrName como cadena
Dim xV como variante

Establecer xSht = hoja activa
Establecer xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

Si xFileDlg.Show = Verdadero Entonces
xFolder = xFileDlg.SelectedItems(1)
otro
MsgBox "Debe especificar una carpeta para guardar el PDF". & vbCrLf & vbCrLf & "Presione OK para salir de esta macro.", vbCritical, "Debe especificar la carpeta de destino"
Exit Sub
Si terminar
xStrName = ""
xV = Application.InputBox("Ingrese el nombre del archivo:", "Kutools para Excel", , , , , , 2)
Si xV = Falso Entonces
Exit Sub
Si terminar
xStrName = xV
Si xStrName = "" Entonces
MsgBox ("No se ingresó ningún nombre de archivo, ¡saliendo del proceso!")
Exit Sub
Si terminar

xFolder = xFolder + "\" + xStrName + ".pdf"
'Comprobar si el archivo ya existe
Si Len(Dir(xFolder)) > 0 Entonces
xSí o No = MsgBox(xFolder & " ya existe." & vbCrLf & vbCrLf & "¿Desea sobrescribirlo?", _
vbSíNo + vbPregunta, "El archivo existe")
On Error Resume Next
Si xSí o No = vbSí Entonces
Matar xFolder
otro
MsgBox "si no sobrescribe el PDF existente, no puedo continuar". _
& vbCrLf & vbCrLf & "Presione OK para salir de esta macro.", vbCritical, "Saliendo de la macro"
Exit Sub
Si terminar
Si Err.Number <> 0 Entonces
MsgBox "No se pudo eliminar el archivo existente. Asegúrese de que el archivo no esté abierto o protegido contra escritura". _
& vbCrLf & vbCrLf & "Presione OK para salir de esta macro.", vbCritical, "No se pudo eliminar el archivo"
Exit Sub
Si terminar
Si terminar

Establecer xUsedRng = xSht.UsedRange
Si Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Entonces
'Guardar como archivo PDF
xSht.ExportAsFixedFormat Tipo:=xlTypePDF, Nombre de archivo:=xFolder, Calidad:=xlQualityStandard

'Crear correo electrónico de Outlook
Establecer xOutlookObj = CreateObject("Outlook.Aplicación")
Establecer xEmailObj = xOutlookObj.CreateItem(0)
Con xEmailObj
.Monitor
.Para = ""
.CC = ""
.Asunto = xSht.Nombre + ".pdf"
.Archivos adjuntos.Agregar xFolder
Si DisplayEmail = False Entonces
'.Enviar
Si terminar
End With
otro
MsgBox "La hoja de trabajo activa no puede estar en blanco"
Exit Sub
Si terminar
End Sub
Responder
Reportar
0
0
mleczus94
mleczus94
Este comentario fue minimizado por el moderador en el sitio
Hola,
Si tengo dos hojas en el archivo y me gustaría ejecutar esta macro en una hoja (presionando el botón) pero enviar otra, ¿cómo puedo obtenerla?
Responder
Reportar
0
0
hein
hein
Este comentario fue minimizado por el moderador en el sitio
Hola, me gustaría guardar esto en una determinada ubicación de archivo, con el nombre basado en el valor de la celda C30. Probé algunas opciones, pero sigo teniendo fallas.
Responder
0
0
cristal
cristal     hein
Este comentario fue minimizado por el moderador en el sitio
Hola hein, el siguiente código tal vez pueda ayudar. Después de ejecutar el código, seleccione una carpeta determinada para guardar el archivo PDF, luego aparecerá un cuadro de diálogo para que ingrese el nombre del archivo. Sub Guardar como pdf y enviar ()
'Actualizado por Extendoffice 20210209
Dim xSht como hoja de trabajo
Dim xFileDlg como FileDialog
Dim xFolder como cadena
Dim xSí o No como entero
Dim xOutlookObj como objeto
Dim xEmailObj como objeto
Dim xUsedRng como rango
Dim xStrName como cadena
Dim xV como variante

Establecer xSht = hoja activa
Establecer xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

Si xFileDlg.Show = Verdadero Entonces
xFolder = xFileDlg.SelectedItems(1)
otro
MsgBox "Debe especificar una carpeta para guardar el PDF". & vbCrLf & vbCrLf & "Presione OK para salir de esta macro.", vbCritical, "Debe especificar la carpeta de destino"
Exit Sub
Si terminar
xStrName = ""
xV = Application.InputBox("Ingrese el nombre del archivo:", "Kutools para Excel", , , , , , 2)
Si xV = Falso Entonces
Exit Sub
Si terminar
xStrName = xV
Si xStrName = "" Entonces
MsgBox ("No se ingresó ningún nombre de archivo, ¡saliendo del proceso!")
Exit Sub
Si terminar

xFolder = xFolder + "\" + xStrName + ".pdf"
'Comprobar si el archivo ya existe
Si Len(Dir(xFolder)) > 0 Entonces
xSí o No = MsgBox(xFolder & " ya existe." & vbCrLf & vbCrLf & "¿Desea sobrescribirlo?", _
vbSíNo + vbPregunta, "El archivo existe")
On Error Resume Next
Si xSí o No = vbSí Entonces
Matar xFolder
otro
MsgBox "si no sobrescribe el PDF existente, no puedo continuar". _
& vbCrLf & vbCrLf & "Presione OK para salir de esta macro.", vbCritical, "Saliendo de la macro"
Exit Sub
Si terminar
Si Err.Number <> 0 Entonces
MsgBox "No se pudo eliminar el archivo existente. Asegúrese de que el archivo no esté abierto o protegido contra escritura". _
& vbCrLf & vbCrLf & "Presione OK para salir de esta macro.", vbCritical, "No se pudo eliminar el archivo"
Exit Sub
Si terminar
Si terminar

Establecer xUsedRng = xSht.UsedRange
Si Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Entonces
'Guardar como archivo PDF
xSht.ExportAsFixedFormat Tipo:=xlTypePDF, Nombre de archivo:=xFolder, Calidad:=xlQualityStandard

'Crear correo electrónico de Outlook
Establecer xOutlookObj = CreateObject("Outlook.Aplicación")
Establecer xEmailObj = xOutlookObj.CreateItem(0)
Con xEmailObj
.Monitor
.Para = ""
.CC = ""
.Asunto = xSht.Nombre + ".pdf"
.Archivos adjuntos.Agregar xFolder
Si DisplayEmail = False Entonces
'.Enviar
Si terminar
End With
otro
MsgBox "La hoja de trabajo activa no puede estar en blanco"
Exit Sub
Si terminar
End Sub
Responder
Reportar
0
0
Hein
Hein     cristal
Este comentario fue minimizado por el moderador en el sitio
Gracias por eso, es genial, pero quiero que la hoja se nombre según la celda A1 en la hoja 1. El lugar para guardar según A1 en la hoja 2, por ejemplo, C:\Users\peete\Dropbox\Screenshots, y enviar por correo electrónico a dirección de correo electrónico en la hoja A3 2 lo que ya he resuelto.
Responder
0
0
HeinPeeters
HeinPeeters     cristal
Este comentario fue minimizado por el moderador en el sitio
Gracias por eso, genial, pero quiero que la hoja se nombre según la celda A1 en la hoja 1. El lugar para guardar según A1 en la hoja 2, por ejemplo, C:\Users\peete\Dropbox\Screenshots, pero puede cambiar cuando usando el archivo y envíelo por correo electrónico a la dirección de correo electrónico en la hoja A3 2 lo que ya he resuelto.
Responder
Reportar
0
0
benspo
benspo
Este comentario fue minimizado por el moderador en el sitio
Hi cristal , excelente código, gracias por compartir. ¿Hay alguna manera de seleccionar varias hojas (del mismo libro de trabajo) para guardar cada una como un PDF independiente y luego enviarlas todas adjuntas en un correo electrónico?
Responder
Reportar
0
0
cristal
cristal     benspo
Este comentario fue minimizado por el moderador en el sitio
Hola, el siguiente código de VBA puede hacerle un favor, inténtelo. En la duodécima línea del código, reemplace los nombres de las hojas con los nombres reales de las hojas en su caso.
Sub Guardar como pdf y enviar 1 ()
Dim xSht como hoja de trabajo
Dim xFileDlg como FileDialog
Dim xFolder como cadena
Dim xSí o No, I, xNum como entero
Dim xOutlookObj como objeto
Dim xEmailObj como objeto
Dim xUsedRng como rango
Dim xArrShetts como variante
Dim xPDFNameAddress como cadena
Dim xStr como cadena
xArrShetts = Array("prueba", "Hoja1", "Hoja2") 'Ingrese los nombres de las hojas que enviará como archivos pdf entre comillas y sepárelos con comas. Asegúrese de que no haya caracteres especiales como \/:"*<>| en el nombre del archivo.

Para I = 0 a UBound(xArrShetts)
On Error Resume Next
Establecer xSht = Application.ActiveWorkbook.Worksheets(xArrShetts(I))
Si xSht.Name <> xArrShetts(I) Entonces
MsgBox "Hoja de trabajo no encontrada, operación de salida:" & vbCrLf & vbCrLf & xArrShetts (I), vbInformation, "Kutools for Excel"
Exit Sub
Si terminar
Siguiente


Establecer xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
Si xFileDlg.Show = Verdadero Entonces
xFolder = xFileDlg.SelectedItems(1)
otro
MsgBox "Debe especificar una carpeta para guardar el PDF". & vbCrLf & vbCrLf & "Presione OK para salir de esta macro.", vbCritical, "Debe especificar la carpeta de destino"
Exit Sub
Si terminar
'Comprobar si el archivo ya existe
xSí o No = MsgBox("Si existen archivos con el mismo nombre en la carpeta de destino, el sufijo numérico se agregará automáticamente al nombre del archivo para distinguir los duplicados" & vbCrLf & vbCrLf & "Haga clic en Sí para continuar, haga clic en No para cancelar", _
vbSíNo + vbPregunta, "El archivo existe")
Si xSí o No <> vbSí, entonces salga de Sub
Para I = 0 a UBound(xArrShetts)
Establecer xSht = Application.ActiveWorkbook.Worksheets(xArrShetts(I))

xStr = xFolder & "\" & xSht.Nombre & ".pdf"
xNúmero = 1
Mientras que no (Dir(xStr, vbDirectory) = vbNullString)
xStr = xFolder & "\" & xSht.Nombre & "_" & xNum & ".pdf"
xNúmero = xNúmero + 1
Encaminarse a
Establecer xUsedRng = xSht.UsedRange
Si Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Entonces
xSht.ExportAsFixedFormat Tipo:=xlTypePDF, Nombre de archivo:=xStr, Calidad:=xlQualityStandard
otro

Si terminar
xArrShetts(I) = xStr
Siguiente

'Crear correo electrónico de Outlook
Establecer xOutlookObj = CreateObject("Outlook.Aplicación")
Establecer xEmailObj = xOutlookObj.CreateItem(0)
Con xEmailObj
.Monitor
.Para = ""
.CC = ""
.Asunto = "????"
Para I = 0 a UBound(xArrShetts)
.Archivos adjuntos.Agregar xArrShetts(I)
Siguiente
Si DisplayEmail = False Entonces
'.Enviar
Si terminar
End With
End Sub
Responder
Reportar
0
0
berneé rodolfo
berneé rodolfo     cristal
Este comentario fue minimizado por el moderador en el sitio
Hola, el único cambio con el que estoy luchando es crear un correo electrónico separado para cada documento pdf creado.
Responder
0
0
cristal
cristal     berneé rodolfo
Este comentario fue minimizado por el moderador en el sitio
Hola, para crear un correo electrónico separado para cada documento pdf, puede ejecutar manualmente el VBA proporcionado en la publicación en diferentes hojas de trabajo para hacerlo.
Responder
Reportar
0
0
berneé rodolfo
berneé rodolfo     cristal
Este comentario fue minimizado por el moderador en el sitio
Tengo más de 100 hojas de trabajo en el libro de trabajo, lo que implicará que debo ejecutar el VBA más de 100 veces, lo que consume mucho tiempo.  
Logré dividir mi libro de trabajo en hojas múltiples y luego puedo convertir cada hoja de trabajo en un documento PDF individual.
La solución que estoy buscando es enviar por correo electrónico cada documento PDF por separado mientras se ejecuta el proceso anterior.
Adjunto el VBA que estoy ejecutando actualmente:
Sub Guardar como pdf y enviar 1 ()
Dim xSht como hoja de trabajo
Dim xFileDlg como FileDialog
Dim xFolder como cadena
Dim xSí o No, I, xNum como entero
Dim xOutlookObj como objeto
Dim xEmailObj como objeto
Dim xUsedRng como rango
Dim xArrShetts como variante
Dim xPDFNameAddress como cadena
Dim xStr como cadena
xArrShetts = Matriz("02302257", "02400438", "02401829", "02403995", "02408001", "02409208", _
"02409980", "02411881", "02424178", "02430454", "02444046", "02448950", "02450600", _
"02459861", "02461750", "02467535", "02480484", "02484749", "02502041", "02504807", _
"02511843", "02515193", "02523098", "02523244", "02524036", "02524548", "02525516", "02525703", "02525898", "02528908", "02528950", _
"02530381", "02531018", "02531252", "02531277", "02532571", "02533053", "02533474", _
"02534176", "02534592", "02534626", "02535343", "02536386", "02536921", "02537544", _
"02537607", "02538015", "02538755", "02538836", "02538910", "02539685", "02540063", "02540139", "02540158", "02541607", "02542344", _
"02543763", "02543985", "02544116", "02544748", "02544762", "02545026", "02545048", _
"02545080", "02545447", "02545730", "02545814", "02546477", "02547458", "02547673", _
"02547833", "02547912", "02547950", "02547991", "02548848", "02549103", "02549116", "02549125", "02549132", "02549140", "02549182", _
"02549462", "02549499", "02549565", "02549687", "02550049", "02550437", "02550812", _
"02550982", "02551004", "02551005", "02551045", "02552099", "02552222", "02552561", _
"02552684", "02552815", "02552892", "02553031", "02553186", "02553628", "02553721", "02555186", "02556934", "02557137", "02557393", _
"02559121", "02559392", "02559419", "02559512", "02559802", "02559868", "02560052", _
"02560612", "02560684", "02560920", "02561018", "02561061", "02561092", "02561227", _
"02561349", "02561592", "02561630", "02561673", "02561880", "02562359", "02562920", "02562934", "02563013", "02563119", "02563133", _
"02563445", "02563737", "02563828", "02563852", "02563861", "02563971", "02564042", _
"02564315", "02564366", "02564832", "02564909", "02565059", "02565205") 'Ingrese los nombres de las hojas que enviará como archivos pdf entre comillas y sepárelos con comas. Asegúrese de que no haya caracteres especiales como \/:"*<>| en el nombre del archivo.

Para I = 0 a UBound(xArrShetts)
On Error Resume Next
Establecer xSht = Application.ActiveWorkbook.Worksheets(xArrShetts(I))
Si xSht.Name <> xArrShetts(I) Entonces
MsgBox "Hoja de trabajo no encontrada, operación de salida:" & vbCrLf & vbCrLf & xArrShetts (I), vbInformation, "Kutools for Excel"
Exit Sub
Si terminar
Siguiente


Establecer xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
Si xFileDlg.Show = Verdadero Entonces
xFolder = xFileDlg.SelectedItems(1)
otro
MsgBox "Debe especificar una carpeta para guardar el PDF". & vbCrLf & vbCrLf & "Presione OK para salir de esta macro.", vbCritical, "Debe especificar la carpeta de destino"
Exit Sub
Si terminar
'Comprobar si el archivo ya existe
xSí o No = MsgBox("Si existen archivos con el mismo nombre en la carpeta de destino, el sufijo numérico se agregará automáticamente al nombre del archivo para distinguir los duplicados" & vbCrLf & vbCrLf & "Haga clic en Sí para continuar, haga clic en No para cancelar", _
vbSíNo + vbPregunta, "El archivo existe")
Si xSí o No <> vbSí, entonces salga de Sub
Para I = 0 a UBound(xArrShetts)
Establecer xSht = Application.ActiveWorkbook.Worksheets(xArrShetts(I))

xStr = xFolder & "\" & xSht.Nombre & ".pdf"
xNúmero = 1
Mientras que no (Dir(xStr, vbDirectory) = vbNullString)
xStr = xFolder & "\" & xSht.Nombre & "_" & xNum & ".pdf"
xNúmero = xNúmero + 1
Encaminarse a
Establecer xUsedRng = xSht.UsedRange
Si Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Entonces
xSht.ExportAsFixedFormat Tipo:=xlTypePDF, Nombre de archivo:=xStr, Calidad:=xlQualityStandard
otro

Si terminar
xArrShetts(I) = xStr
Siguiente

'Crear correo electrónico de Outlook
Establecer xOutlookObj = CreateObject("Outlook.Aplicación")
Establecer xEmailObj = xOutlookObj.CreateItem(0)
Con xEmailObj
.Monitor
.Para = "Ctracklegal@ctrack.com"
.CC = ""
.Asunto = "????"
Para I = 0 a UBound(xArrShetts)
On Error Resume Next
.Archivos adjuntos.Agregar xArrShetts(I)
Siguiente
Si DisplayEmail = False Entonces
.Enviar
Exit Sub
Si terminar
End With


End Sub
Responder
0
0
Tori
Tori
Este comentario fue minimizado por el moderador en el sitio
Hola @cristal
Esto es fabuloso: la cosa clave con la que estoy luchando es el nombre del archivo. Me gustaría que el nombre del archivo se extraiga de una celda en la hoja de trabajo en lugar de usar el nombre de la pestaña. Ya edité el código para guardarlo automáticamente en una carpeta específica, pero tengo problemas con el nombre del archivo.
¿Alguna ayuda que pueda ofrecer, por favor?
Responder
0
0
cristal
cristal     Tori
Este comentario fue minimizado por el moderador en el sitio
Hola Tori, si desea nombrar el archivo PDF con un valor de celda específico, intente con el siguiente código. Después de ejecutar el código y seleccionar una carpeta para guardar el archivo, aparece otro cuadro de diálogo, seleccione la celda que usará el valor como el nombre del archivo PDF y luego haga clic en Aceptar para finalizar.
Sub Guardar como pdf y enviar 2 ()
'Actualizado por Extendoffice 20210521
Dim xSht como hoja de trabajo
Dim xFileDlg como FileDialog
Dim xFolder como cadena
Dim xSí o No como entero
Dim xOutlookObj como objeto
Dim xEmailObj como objeto
Dim xUsedRng, xRgInser como rango
Dim xB como booleano
Establecer xSht = hoja activa
Establecer xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

Si xFileDlg.Show = Verdadero Entonces
xFolder = xFileDlg.SelectedItems(1)
otro
MsgBox "Debe especificar una carpeta para guardar el PDF". & vbCrLf & vbCrLf & "Presione OK para salir de esta macro.", vbCritical, "Debe especificar la carpeta de destino"
Exit Sub
Si terminar
xB = Verdadero
On Error Resume Next
Mientras xB
Establecer xRgInser = Nada
Establezca xRgInser = Application.InputBox ("Seleccione una celda en la que usará el valor para nombrar el archivo PDF:", "Kutools para Excel", , , , , , 8)
Si xRgInser no es nada, entonces
MsgBox "No se seleccionó ninguna celda, ¡salga de la operación!", vbInformation, "Kutools for Excel"
Exit Sub
Si terminar
Si xRgInser.Text = "" Entonces
MsgBox "La celda seleccionada está en blanco, ¡vuelva a seleccionarla!", vbInformation, "Kutools for Excel"
otro
xB = Falso
Si terminar
Encaminarse a

xFolder = xFolder + "\" + xRgInser.Text + ".pdf"

'Comprobar si el archivo ya existe
Si Len(Dir(xFolder)) > 0 Entonces
xSí o No = MsgBox(xFolder & " ya existe." & vbCrLf & vbCrLf & "¿Desea sobrescribirlo?", _
vbSíNo + vbPregunta, "El archivo existe")
On Error Resume Next
Si xSí o No = vbSí Entonces
Matar xFolder
otro
MsgBox "si no sobrescribe el PDF existente, no puedo continuar". _
& vbCrLf & vbCrLf & "Presione OK para salir de esta macro.", vbCritical, "Saliendo de la macro"
Exit Sub
Si terminar
Si Err.Number <> 0 Entonces
MsgBox "No se pudo eliminar el archivo existente. Asegúrese de que el archivo no esté abierto o protegido contra escritura". _
& vbCrLf & vbCrLf & "Presione OK para salir de esta macro.", vbCritical, "No se pudo eliminar el archivo"
Exit Sub
Si terminar
Si terminar

Establecer xUsedRng = xSht.UsedRange
Si Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Entonces
'Guardar como archivo PDF
xSht.ExportAsFixedFormat Tipo:=xlTypePDF, Nombre de archivo:=xFolder, Calidad:=xlQualityStandard

'Crear correo electrónico de Outlook
Establecer xOutlookObj = CreateObject("Outlook.Aplicación")
Establecer xEmailObj = xOutlookObj.CreateItem(0)
Con xEmailObj
.Monitor
.Para = ""
.CC = ""
.Asunto = xSht.Nombre + ".pdf"
.Archivos adjuntos.Agregar xFolder
Si DisplayEmail = False Entonces
'.Enviar
Si terminar
End With
otro
MsgBox "La hoja de trabajo activa no puede estar en blanco"
Exit Sub
Si terminar
End Sub
Responder
Reportar
0
0
Makeeuropeanu
Makeeuropeanu
Este comentario fue minimizado por el moderador en el sitio
Hola, necesitaba algo similar, así que esto es lo que obtuve. Toma la fecha actual y crea una nueva carpeta con el nombre de la fecha en una ubicación específica. Coloca el pdf dentro de esa nueva ubicación, luego adjunta el pdf en un nuevo correo electrónico. Funciona como un regalo. Solo soy un principiante, así que discúlpeme si parece un desastre. :D
PDF secundario CORREO ELECTRÓNICO()
Dim xSht como hoja de trabajo
Dim xFileDlg como FileDialog
Dim xFolder como cadena
Dim xSí o No como entero
Dim xOutlookObj como objeto
Dim xEmailObj como objeto
Dim xUsedRng como rango
Atenuar xPath como cadena
Dim xOutMsg como cadena
Dim sFolderName como cadena, sFolder como cadena
Dim sFolderPath como cadena

Establecer xSht = hoja activa
xFileDate = Format(Ahora, "dd-mm-yyyy")
sFolder = "C:" 'aquí es donde tienes una carpeta principal
sFolderName = "Finalización de la semana" + Formato (Ahora, "dd-mm-yyyy") 'carpeta que se creará en la carpeta principal con el nombre Fin de la semana y fecha actual
sFolderPath = "C:" & sFolderName 'carpeta principal nuevamente para crear la nueva ruta, incluida la nueva carpeta
Establecer oFSO = CreateObject("Scripting.FileSystemObject")
Si oFSO.FolderExists(sFolderPath) Entonces
MsgBox "¡La carpeta ya existe!" & vbCrLf & vbCrLf & sFolderPath, vbInformation, "INFO"
otro
MkDir sFolderPath
MsgBox "¡Se ha creado una nueva carpeta!" & vbCrLf & vbCrLf & sFolderPath, vbInformation, "INFO"
Si terminar
xPath = sFolderPath
xFolder = xPath + "\" + xSht.Name + "_" + xFileDate + ".pdf"
Si Len(Dir(xFolder)) > 0 Entonces
xSí o No = MsgBox(xFolder & " ya existe." & vbCrLf & vbCrLf & "¿Desea sobrescribirlo?", _
vbSíNo + vbPregunta, "El archivo existe")
On Error Resume Next
Si xSí o No = vbSí Entonces
Matar xFolder
otro
MsgBox "si no sobrescribe el PDF existente, no puedo continuar". _
& vbCrLf & vbCrLf & "Presione OK para salir de esta macro.", vbCritical, "Saliendo de la macro"
Exit Sub
Si terminar
Si Err.Number <> 0 Entonces
MsgBox "No se pudo eliminar el archivo existente. Asegúrese de que el archivo no esté abierto o protegido contra escritura". _
& vbCrLf & vbCrLf & "Presione OK para salir de esta macro.", vbCritical, "No se pudo eliminar el archivo"
Exit Sub
Si terminar
Si terminar

Establecer xUsedRng = xSht.UsedRange
Si Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Entonces
xSht.ExportAsFixedFormat Tipo:=xlTypePDF, Nombre de archivo:=xFolder, Calidad:=xlQualityStandard
Establecer xOutlookObj = CreateObject("Outlook.Aplicación")
Establecer xEmailObj = xOutlookObj.CreateItem(0)
xOutMsg = " Por favor encuentre adjunto Este correo electrónico y el archivo adjunto se generaron automáticamente "
'agrega una nota de que el correo electrónico se generó automáticamente

Con xEmailObj
.Monitor
.To = "" 'agregar sus propios correos electrónicos
.CC = ""
.Asunto = xSht.Name + " PDF para la semana que termina " + xFileDate + " - Ubicación " ' el asunto incluye el nombre de la hoja, el pdf, la fecha y la ubicación, esto se puede editar según sea necesario
.Archivos adjuntos.Agregar xFolder
.HTMLBody = xOutMsg & .HTMLBody
Si DisplayEmail = False Entonces
'.Send <--- Aquí, si elimina el apóstrofe, el correo electrónico se enviará automáticamente, así que tenga cuidado
Si terminar
End With
otro
MsgBox "La hoja de trabajo activa no puede estar en blanco"
Exit Sub
Si terminar
End Sub
Responder
Reportar
0
0
Nicole
Nicole
Este comentario fue minimizado por el moderador en el sitio
¿Cómo edito este código para guardar solo celdas ("a1: r99") para guardar como PDF? Tengo cosas adicionales en los lados que no quiero en mi documento PDF.
Sub Guardar como pdf y enviar ()
'Actualizado por Extendoffice 20210209
Dim xSht como hoja de trabajo
Dim xFileDlg como FileDialog
Dim xFolder como cadena
Dim xSí o No como entero
Dim xOutlookObj como objeto
Dim xEmailObj como objeto
Dim xUsedRng como rango
Dim xStrName como cadena
Dim xV como variante

Establecer xSht = hoja activa
Establecer xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

Si xFileDlg.Show = Verdadero Entonces
xFolder = xFileDlg.SelectedItems(1)
otro
MsgBox "Debe especificar una carpeta para guardar el PDF". & vbCrLf & vbCrLf & "Presione OK para salir de esta macro.", vbCritical, "Debe especificar la carpeta de destino"
Exit Sub
Si terminar
xStrName = ""
xV = Application.InputBox("Ingrese el nombre del archivo:", "Kutools para Excel", , , , , , 2)
Si xV = Falso Entonces
Exit Sub
Si terminar
xStrName = xV
Si xStrName = "" Entonces
MsgBox ("No se ingresó ningún nombre de archivo, ¡saliendo del proceso!")
Exit Sub
Si terminar

xFolder = xFolder + "\" + xStrName + ".pdf"
'Comprobar si el archivo ya existe
Si Len(Dir(xFolder)) > 0 Entonces
xSí o No = MsgBox(xFolder & " ya existe." & vbCrLf & vbCrLf & "¿Desea sobrescribirlo?", _
vbSíNo + vbPregunta, "El archivo existe")
On Error Resume Next
Si xSí o No = vbSí Entonces
Matar xFolder
otro
MsgBox "si no sobrescribe el PDF existente, no puedo continuar". _
& vbCrLf & vbCrLf & "Presione OK para salir de esta macro.", vbCritical, "Saliendo de la macro"
Exit Sub
Si terminar
Si Err.Number <> 0 Entonces
MsgBox "No se pudo eliminar el archivo existente. Asegúrese de que el archivo no esté abierto o protegido contra escritura". _
& vbCrLf & vbCrLf & "Presione OK para salir de esta macro.", vbCritical, "No se pudo eliminar el archivo"
Exit Sub
Si terminar
Si terminar

Establecer xUsedRng = xSht.UsedRange
Si Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Entonces
'Guardar como archivo PDF
xSht.ExportAsFixedFormat Tipo:=xlTypePDF, Nombre de archivo:=xFolder, Calidad:=xlQualityStandard

'Crear correo electrónico de Outlook
Establecer xOutlookObj = CreateObject("Outlook.Aplicación")
Establecer xEmailObj = xOutlookObj.CreateItem(0)
Con xEmailObj
.Monitor
.Para = ""
.CC = ""
.Asunto = xSht.Nombre + ".pdf"
.Archivos adjuntos.Agregar xFolder
Si DisplayEmail = False Entonces
'.Enviar
Si terminar
End With
otro
MsgBox "La hoja de trabajo activa no puede estar en blanco"
Exit Sub
Si terminar
End Sub
Responder
0
0
RLF
RLF     Nicole
Este comentario fue minimizado por el moderador en el sitio
Hola, acabo de probar este código en una de mis hojas de trabajo y tengo áreas de impresión configuradas para que las cosas adicionales en la parte inferior no aparezcan en el pdf. ¡Intentalo!
Responder
0
0
Rod Bennett
Rod Bennett
Este comentario fue minimizado por el moderador en el sitio
Hi
Muchas gracias por el Código, pero ¿es posible guardar el PDF automáticamente en la misma ubicación que el archivo de Excel activo y con el mismo nombre de archivo que el archivo de Excel activo?
Muchas gracias.
Barra
Responder
0
0
No hay comentarios publicados aquí todavía
Ver más
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