Note: The other languages of the website are Google-translated. Back to English

Como salvar uma planilha como arquivo PDF e e-mail como um anexo através do Outlook?

Em alguns casos, pode ser necessário enviar uma planilha como um arquivo PDF pelo Outlook. Normalmente, você tem que salvar manualmente a planilha como um arquivo PDF, em seguida, criar um novo e-mail com esse arquivo PDF como anexo em seu Outlook e, finalmente, enviá-lo. É demorado fazer isso manualmente, passo a passo. Neste artigo, mostraremos como salvar rapidamente uma planilha como um arquivo PDF e enviá-la automaticamente como um anexo através do Outlook no Excel.

Salve uma planilha como arquivo PDF e envie por e-mail como um anexo com o código VBA


Salve uma planilha como arquivo PDF e envie por e-mail como um anexo com o código VBA

Você pode executar o código VBA abaixo para salvar automaticamente a planilha ativa como um arquivo PDF e enviá-la por e-mail como um anexo pelo Outlook. Faça o seguinte.

1. Abra a planilha que você salvará como PDF e enviará e pressione o botão outro + F11 simultaneamente para abrir o Microsoft Visual Basic para Aplicações janela.

2. No Microsoft Visual Basic para Aplicações janela, clique em inserção > Módulo. Em seguida, copie e cole o código VBA abaixo no Código janela. Veja a imagem:

Código VBA: salve uma planilha como arquivo PDF e envie por e-mail como um anexo

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. aperte o F5 chave para executar o código. No Procurar caixa de diálogo, selecione uma pasta para salvar este arquivo PDF e clique no OK botão.

Notas:

1. Agora a planilha ativa é salva como um arquivo PDF. E o arquivo PDF é nomeado com o nome da planilha.
2. Se a planilha ativa estiver em branco, você receberá uma caixa de diálogo como a imagem abaixo mostrada após clicar no OK botão.

4. Agora um novo e-mail do Outlook foi criado e você pode ver o arquivo PDF listado como um anexo no campo Anexado. Veja a imagem:

5. Escreva este e-mail e envie-o.
6. Este código está disponível apenas quando você usa o Outlook como seu programa de e-mail.

Salve facilmente uma planilha ou várias planilhas como arquivos PDF separados de uma vez:

O Dividir a pasta de trabalho utilidade de Kutools for Excel pode ajudá-lo a salvar facilmente uma planilha ou várias planilhas como arquivos PDF separados de uma vez, conforme a demonstração abaixo. Baixe e experimente agora! (30- dia de trilha livre)


Artigos relacionados:


As melhores ferramentas de produtividade para escritório

O Kutools for Excel resolve a maioria dos seus problemas e aumenta sua produtividade em 80%

  • armadilha para peixes: Insira rapidamente fórmulas complexas, gráficos e qualquer coisa que você tenha usado antes; Criptografar células com senha; Criar lista de discussão e enviar emails ...
  • Barra Super Fórmula (edite facilmente várias linhas de texto e fórmula); Layout de leitura (ler e editar facilmente um grande número de células); Colar na faixa filtrada...
  • Mesclar células / linhas / colunas sem perder dados; Dividir o conteúdo das células; Combinar linhas / colunas duplicadas... Evite células duplicadas; Comparar intervalos...
  • Selecione Duplicado ou Único Linhas; Selecione linhas em branco (todas as células estão vazias); Super Find e Fuzzy Find em muitos livros; Seleção aleatória ...
  • Cópia exata Várias células sem alterar a referência da fórmula; Criação automática de referências para várias folhas; Inserir marcadores, Caixas de seleção e mais ...
  • Extrair Texto, Adicionar texto, remover por posição, Remover Espaço; Criar e imprimir subtotais de paginação; Converter entre conteúdo de células e comentários...
  • Super Filtro (salvar e aplicar esquemas de filtro a outras planilhas); Classificação Avançada por mês / semana / dia, frequência e mais; Filtro Especial por negrito, itálico ...
  • Combine pastas de trabalho e planilhas; Mesclar tabelas com base em colunas-chave; Divida os dados em várias folhas; Conversão em lote de xls, xlsx e PDF...
  • Mais de 300 recursos poderosos. Suporta Office / Excel 2007-2021 e 365. Suporta todos os idiomas. Fácil implantação em sua empresa ou organização. Recursos completos de avaliação gratuita de 30 dias. Garantia de devolução do dinheiro em 60 dias.
guia kte 201905

Guia do Office traz interface com guias para o Office e torna seu trabalho muito mais fácil

  • Habilite a edição e leitura com guias em Word, Excel, PowerPoint, Publisher, Access, Visio e Project.
  • Abra e crie vários documentos em novas guias da mesma janela, em vez de em novas janelas.
  • Aumenta sua produtividade em 50% e reduz centenas de cliques do mouse para você todos os dias!
parte inferior da aba do escritório
Comentários (63)
Avaliado 5 fora do 5 · classificações 1
Este comentário foi feito pelo moderador no site
Isso está funcionando muito bem para mim, mas existe uma maneira de selecionar um local de pasta automaticamente em vez de selecionar manualmente? Estou esperando para fazer isso para 40 folhas de uma vez.
Este comentário foi feito pelo moderador no site
Também espero ver uma resposta para este problema! Obrigado pela ajuda!
Este comentário foi feito pelo moderador no site
Eu tentei colar isso em um novo módulo e recebo erro de compilação: Sub ou função não definida. Por favor ajude.
Este comentário foi feito pelo moderador no site
Caro Darren,
Qual versão do Office você usa?
Este comentário foi feito pelo moderador no site
Office 360
Este comentário foi feito pelo moderador no site
Mesmo problema
Este comentário foi feito pelo moderador no site
Como eu editaria o script VBA acima para que ele adicionasse um carimbo de data e hora ao nome do arquivo de forma que não sobrescrevesse o que já estava salvo?
Este comentário foi feito pelo moderador no site
Querido Michael,
Execute o código VBA abaixo para resolver o problema.

Sub Salvar como PDF e enviar ()
Dim xSht As Planilha
Dim xFileDlg As FileDialog
Dim xFolder como String
Dim xYesouNo As Integer
Dim xOutlookObj como objeto
Dim xEmailObj como objeto
Dim xUsedRng As Range
Dim xStr As String

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

Se xFileDlg.Show = True Então
xFolder = xFileDlg.SelectedItems(1)
Outro
MsgBox "Você deve especificar uma pasta para salvar o PDF." & vbCrLf & vbCrLf & "Pressione OK para sair desta macro.", vbCritical, "Deve especificar a pasta de destino"
Exit Sub
Se acabar
xStr = Format(Now(), "aaaa-mm-dd-hh-mm-ss")
xFolder = xFolder + "\" + xSht.Name + "-" + xStr + ".pdf"

'Verifica se o arquivo já existe
Se Len(Dir(xFolder)) > 0 Então
xYesorNo = MsgBox(xFolder & " já existe." & vbCrLf & vbCrLf & "Deseja substituir?", _
vbYesNo + vbQuestion, "O arquivo existe")
On Error Resume Next
Se xSim ou Não = vbSim Então
Matar xFolder
Outro
MsgBox "se você não substituir o PDF existente, não posso continuar." _
& vbCrLf & vbCrLf & "Pressione OK para sair desta macro.", vbCritical, "Sair da Macro"
Exit Sub
Se acabar
If Err.Number <> 0 Then
MsgBox "Não foi possível excluir o arquivo existente. Certifique-se de que o arquivo não esteja aberto ou protegido contra gravação." _
& vbCrLf & vbCrLf & "Pressione OK para sair desta macro.", vbCritical, "Não foi possível excluir o arquivo"
Exit Sub
Se acabar
Se acabar

Definir xUsedRng = xSht.UsedRange
Se Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Then
'Salvar como arquivo PDF
xSht.ExportAsFixedFormat Tipo:=xlTypePDF, Nome do arquivo:=xFolder, Qualidade:=xlQualityStandard

'Cria e-mail do Outlook
Set xOutlookObj = CreateObject("Outlook.Application")
Definir xEmailObj = xOutlookObj.CreateItem(0)
Com xEmailObj
.Exibição
.Para = ""
.CC = ""
.Assunto = xSht.Name + "-" + xStr + ".pdf"
.Anexos.Adicionar xFolder
Se DisplayEmail = False Então
'.Mandar
Se acabar
Terminar com
Outro
MsgBox "A planilha ativa não pode ficar em branco"
Exit Sub
Se acabar
End Sub
Este comentário foi feito pelo moderador no site
Olá Cristal,

É realmente ótimo e funcionando perfeitamente para mim. Precisa de mais ajuda para adicionar:

1. em "Para" eu quero dar um link para uma célula específica da planilha ativa como no CC e em BCC eu gostaria de adicionar o link da planilha ativa
2. no corpo do e-mail eu preciso especificar algum texto padrão.

Eu serei grande cheio para você por sua ajuda.

obrigado
Parag
Este comentário foi feito pelo moderador no site
Olá Parag Somani,
O código VBA abaixo pode ajudá-lo. Altere os campos .To, .CC, .BCC e .Body com base em suas necessidades.

Sub Salvar como PDF e enviar ()
Dim xSht As Planilha
Dim xFileDlg As FileDialog
Dim xFolder como String
Dim xYesouNo As Integer
Dim xOutlookObj como objeto
Dim xEmailObj como objeto
Dim xUsedRng As Range
Dim xStr As String

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

Se xFileDlg.Show = True Então
xFolder = xFileDlg.SelectedItems(1)
Outro
MsgBox "Você deve especificar uma pasta para salvar o PDF." & vbCrLf & vbCrLf & "Pressione OK para sair desta macro.", vbCritical, "Deve especificar a pasta de destino"
Exit Sub
Se acabar
xStr = Format(Now(), "aaaa-mm-dd-hh-mm-ss")
xFolder = xFolder + "\" + xSht.Name + "-" + xStr + ".pdf"

'Verifica se o arquivo já existe
Se Len(Dir(xFolder)) > 0 Então
xYesorNo = MsgBox(xFolder & " já existe." & vbCrLf & vbCrLf & "Deseja substituir?", _
vbYesNo + vbQuestion, "O arquivo existe")
On Error Resume Next
Se xSim ou Não = vbSim Então
Matar xFolder
Outro
MsgBox "se você não substituir o PDF existente, não posso continuar." _
& vbCrLf & vbCrLf & "Pressione OK para sair desta macro.", vbCritical, "Sair da Macro"
Exit Sub
Se acabar
If Err.Number <> 0 Then
MsgBox "Não foi possível excluir o arquivo existente. Certifique-se de que o arquivo não esteja aberto ou protegido contra gravação." _
& vbCrLf & vbCrLf & "Pressione OK para sair desta macro.", vbCritical, "Não foi possível excluir o arquivo"
Exit Sub
Se acabar
Se acabar

Definir xUsedRng = xSht.UsedRange
Se Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Then
'Salvar como arquivo PDF
xSht.ExportAsFixedFormat Tipo:=xlTypePDF, Nome do arquivo:=xFolder, Qualidade:=xlQualityStandard

'Cria e-mail do Outlook
Set xOutlookObj = CreateObject("Outlook.Application")
Definir xEmailObj = xOutlookObj.CreateItem(0)
Com xEmailObj
.Exibição
.To = Range("A8")
.CC = Range("A9")
.BCC = Range("A10")
.Assunto = xSht.Name + "-" + xStr + ".pdf"
.Body = "Querido" _
& vbNewLine & vbNewLine & _
"Este é um e-mail de teste" & _
"enviando em Excel"
.Anexos.Adicionar xFolder
Se DisplayEmail = False Então
'.Mandar
Se acabar
Terminar com
Outro
MsgBox "A planilha ativa não pode ficar em branco"
Exit Sub
Se acabar
End Sub
Este comentário foi feito pelo moderador no site
Eu tenho tentado usar o Range para "To", "CC", ele simplesmente não pega os valores da célula designada. Você pode por favor ajudar nisso?
Obrigado,
Mehul
Este comentário foi feito pelo moderador no site
Olá Cristal,

É realmente ótimo e funcionando perfeitamente para mim. Precisa de mais ajuda para adicionar:

1. em "Para" eu quero dar um link para uma célula específica da planilha ativa como no CC e em BCC eu gostaria de adicionar o link da planilha ativa
2. no corpo do e-mail eu preciso especificar algum texto padrão.

Eu serei grande cheio para você por sua ajuda.

obrigado
Parag
Este comentário foi feito pelo moderador no site
Olá Cristal,

É realmente ótimo e funcionando perfeitamente para mim. Precisa de mais ajuda para adicionar:

1. em "Para" eu quero dar um link para uma célula específica da planilha ativa como no CC e em BCC eu gostaria de adicionar o link da planilha ativa
2. no corpo do e-mail eu preciso especificar algum texto padrão.

Eu serei grande cheio para você por sua ajuda.

obrigado
Parag
Este comentário foi feito pelo moderador no site
Como posso adicionar, por exemplo, a folha 2 da pasta de trabalho como um pdf?
Este comentário foi feito pelo moderador no site
Olá Armin,
Você precisa abrir a Planilha 2 em sua pasta de trabalho primeiro e, em seguida, executar o código VBA com as etapas acima para baixá-lo.
Este comentário foi feito pelo moderador no site
Como editar o script VBA acima para que o nome do arquivo seja salvo como uma célula específica selecionada na planilha atual, por exemplo, célula A1?
Este comentário foi feito pelo moderador no site
Oi Tom.
Desculpe não pode ajudar com isso.
Bem-vindo a postar qualquer pergunta em nosso fórum: https://www.extendoffice.com/forum.html
Você obterá mais suporte do Excel de profissionais do Excel ou de outros fãs do Excel.
Este comentário foi feito pelo moderador no site
Oi, como posso salvar e enviar o pdf com o nome da pasta de trabalho com o código VBA atual? o que eu uso em vez de xSht.Name
Este comentário foi feito pelo moderador no site
Oi James,
Deseja enviar a planilha ativa como pdf e nomeá-la como o nome da pasta de trabalho?
Este comentário foi feito pelo moderador no site
Obrigado funciona.
Este comentário foi feito pelo moderador no site
Como posso fazer com que ele exclua o pdf salvo depois de enviá-lo por e-mail?
Este comentário foi feito pelo moderador no site
Oi Jason,
Desculpe, não posso ajudá-lo com isso ainda. Você precisa excluí-lo manualmente após enviá-lo por e-mail.
Este comentário foi feito pelo moderador no site
Olá,

É possível encontrar o nome do pdf de uma célula? Ex. Célula H4


E na célula H4 eu quero coletar de três células diferentes. Isso é possível?
Este comentário foi feito pelo moderador no site
Isso é possível. Faça variáveis ​​separadas para manter o valor das células e, em seguida, use essas variáveis ​​ao definir xFolder.
Usei o valor de uma célula da minha planilha mais a data de hoje. Você pode facilmente fazer vários valores de célula.

Isto é o que eu adicionei:
Dim xMemberName As String
Dim xFileDate como string

xMemberName = Range("H3").Value
xFileDate = Format(Agora, "mm-dd")

xFolder = xFolder + "\" xMemberName + xFileDate + ".pdf"
Este comentário foi feito pelo moderador no site
Estou recebendo um erro quando tento isso, onde no código devo colocar isso?
Este comentário foi feito pelo moderador no site
Olá Cristal,



É realmente ótimo e funcionando perfeitamente para mim. Precisa de mais ajuda para adicionar:

1. em "Corpo" quero dar link para determinada célula da planilha Ativa. Além disso, gostaria de negrito o texto.

obrigado

Saudações

Kishore Kumar
Este comentário foi feito pelo moderador no site
Oi,

Você quer adicionar o valor da célula automaticamente ao corpo do correio e colocá-lo em negrito? Supondo que você adicione o valor de C4 ao corpo do email. Por favor, aplique o código abaixo.

Sub Salvar como PDF e enviar ()

Dim xSht As Planilha

Dim xFileDlg As FileDialog

Dim xFolder como String

Dim xYesouNo As Integer

Dim xOutlookObj como objeto

Dim xEmailObj como objeto

Dim xUsedRng As Range



Definir xSht = ActiveSheet

Definir xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)



Se xFileDlg.Show = True Então

xFolder = xFileDlg.SelectedItems(1)

Outro

MsgBox "Você deve especificar uma pasta para salvar o PDF." & vbCrLf & vbCrLf & "Pressione OK para sair desta macro.", vbCritical, "Deve especificar a pasta de destino"

Exit Sub

Se acabar

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



'Verifica se o arquivo já existe

Se Len(Dir(xFolder)) > 0 Então

xYesorNo = MsgBox(xFolder & " já existe." & vbCrLf & vbCrLf & "Deseja substituir?", _

vbYesNo + vbQuestion, "O arquivo existe")

On Error Resume Next

Se xSim ou Não = vbSim Então

Matar xFolder

Outro

MsgBox "se você não substituir o PDF existente, não posso continuar." _

& vbCrLf & vbCrLf & "Pressione OK para sair desta macro.", vbCritical, "Sair da Macro"

Exit Sub

Se acabar

If Err.Number <> 0 Then

MsgBox "Não foi possível excluir o arquivo existente. Certifique-se de que o arquivo não esteja aberto ou protegido contra gravação." _

& vbCrLf & vbCrLf & "Pressione OK para sair desta macro.", vbCritical, "Não foi possível excluir o arquivo"

Exit Sub

Se acabar

Se acabar



Definir xUsedRng = xSht.UsedRange

Se Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Then

'Salvar como arquivo PDF

xSht.ExportAsFixedFormat Tipo:=xlTypePDF, Nome do arquivo:=xFolder, Qualidade:=xlQualityStandard



'Cria e-mail do Outlook

Set xOutlookObj = CreateObject("Outlook.Application")

Definir xEmailObj = xOutlookObj.CreateItem(0)

Com xEmailObj

.Exibição

.Para = ""

.CC = ""

.Assunto = xSht.Name + ".pdf"

.Anexos.Adicionar xFolder

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

Se DisplayEmail = False Então

'.Mandar

Se acabar

Terminar com

Outro

MsgBox "A planilha ativa não pode ficar em branco"

Exit Sub

Se acabar

End Sub
Este comentário foi feito pelo moderador no site
Se eu quisesse que ele salvasse automaticamente em uma pasta específica todas as vezes (eliminando a necessidade de o usuário escolher a pasta), como eu faria isso?
Ex. C: Faturas/América do Norte/Clientes
Ajuda é muito apreciada.
Este comentário foi feito pelo moderador no site
Olá Geoff,
Você quer dizer salvar a planilha como um arquivo pdf e salvar em uma pasta específica sem enviar?
Este comentário foi feito pelo moderador no site
Acho que Geoff significa poder especificar uma pasta específica no código em que o pdf é salvo a cada vez, em vez de ter que selecionar o local manualmente. O pdf é então enviado por e-mail dessa pasta específica.
Este comentário foi feito pelo moderador no site
Obrigado Jeremias.
Este comentário foi feito pelo moderador no site
Oi Geoff, Se você deseja salvar automaticamente o arquivo pdf em uma pasta específica em vez de selecionar o local manualmente, tente o código abaixo. Não se esqueça de alterar o caminho da pasta no código.
Sub SaveAsPDFandSend()
Dim xSht As Planilha
Dim xFileDlg As FileDialog
Dim xFolder como String
Dim xYesouNo As Integer
Dim xOutlookObj como objeto
Dim xEmailObj como objeto
Dim xUsedRng As Range
Dim xPath como string
Definir xSht = ActiveSheet
xPath = "C:\Users\Win10x64Test\Desktop\worksheet para pdf" 'aqui "workshet to pdf" é a pasta de destino para salvar os arquivos pdf
xFolder = xPath + "\" + xSht.Name + ".pdf"
Se Len(Dir(xFolder)) > 0 Então
xYesorNo = MsgBox(xFolder & " já existe." & vbCrLf & vbCrLf & "Deseja substituir?", _
vbYesNo + vbQuestion, "O arquivo existe")
On Error Resume Next
Se xSim ou Não = vbSim Então
Matar xFolder
Outro
MsgBox "se você não substituir o PDF existente, não posso continuar." _
& vbCrLf & vbCrLf & "Pressione OK para sair desta macro.", vbCritical, "Sair da Macro"
Exit Sub
Se acabar
If Err.Number <> 0 Then
MsgBox "Não foi possível excluir o arquivo existente. Certifique-se de que o arquivo não esteja aberto ou protegido contra gravação." _
& vbCrLf & vbCrLf & "Pressione OK para sair desta macro.", vbCritical, "Não foi possível excluir o arquivo"
Exit Sub
Se acabar
Se acabar

Definir xUsedRng = xSht.UsedRange
Se Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Then
'Salvar como arquivo PDF
xSht.ExportAsFixedFormat Tipo:=xlTypePDF, Nome do arquivo:=xFolder, Qualidade:=xlQualityStandard

'Cria e-mail do Outlook
Set xOutlookObj = CreateObject("Outlook.Application")
Definir xEmailObj = xOutlookObj.CreateItem(0)
Com xEmailObj
.Exibição
.Para = ""
.CC = ""
.Assunto = xSht.Name + ".pdf"
.Anexos.Adicionar xFolder
Se DisplayEmail = False Então
'.Mandar
Se acabar
Terminar com
Outro
MsgBox "A planilha ativa não pode ficar em branco"
Exit Sub
Se acabar
End Sub
Este comentário foi feito pelo moderador no site
Este código funciona muito bem, exceto que eu quero que a planilha seja salva como nome da planilha + data (ou seja, Sheet1 Oct 1 2020); na área de trabalho do usuário (isso será usado por várias pessoas e seus caminhos podem variar um pouco). Se possível, quero incorporar um .jpg no corpo também.. o JPG está localizado dentro da planilha (fora da área de impressão) e a imagem é armazenada em um servidor compartilhado.. embora o caminho para o servidor varie de acordo com usuário (para a maioria é uma unidade "T" para alguns uma unidade "U")
isso pode ser feito? por favor e obrigado um milhão de vezes.
Este comentário foi feito pelo moderador no site

Oi, está funcionando muito bem, obrigado por compartilhar, só preciso de uma ajuda.
Se eu quiser salvar um arquivo PDF com nome personalizado (opção de digitar o nome do arquivo na caixa de diálogo Salvar como), como usuário, use esta opção no modelo de formulário onde os formulários são salvos como PDF com nome exclusivo .
Este comentário foi feito pelo moderador no site
Oi, Por favor, tente o código VBA abaixo. Depois de executar o código, selecione uma pasta para salvar o arquivo PDF, então uma caixa de diálogo aparecerá para você inserir o nome do arquivo. Sub Saveaspdfandsend()
'Atualizado por Extendoffice 20210209
Dim xSht As Planilha
Dim xFileDlg As FileDialog
Dim xFolder como String
Dim xYesouNo As Integer
Dim xOutlookObj como objeto
Dim xEmailObj como objeto
Dim xUsedRng As Range
Dim xStrName As String
Dim xV como variante

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

Se xFileDlg.Show = True Então
xFolder = xFileDlg.SelectedItems(1)
Outro
MsgBox "Você deve especificar uma pasta para salvar o PDF." & vbCrLf & vbCrLf & "Pressione OK para sair desta macro.", vbCritical, "Deve especificar a pasta de destino"
Exit Sub
Se acabar
xStrName = ""
xV = Application.InputBox("Digite o nome do arquivo:", "Kutools for Excel", , , , , , 2)
Se xV = Falso Então
Exit Sub
Se acabar
xStrName = xV
Se xStrName = "" Então
MsgBox ("Nenhum nome de arquivo inserido, saindo do processo!")
Exit Sub
Se acabar

xFolder = xFolder + "\" + xStrName + ".pdf"
'Verifica se o arquivo já existe
Se Len(Dir(xFolder)) > 0 Então
xYesorNo = MsgBox(xFolder & " já existe." & vbCrLf & vbCrLf & "Deseja substituir?", _
vbYesNo + vbQuestion, "O arquivo existe")
On Error Resume Next
Se xSim ou Não = vbSim Então
Matar xFolder
Outro
MsgBox "se você não substituir o PDF existente, não posso continuar." _
& vbCrLf & vbCrLf & "Pressione OK para sair desta macro.", vbCritical, "Sair da Macro"
Exit Sub
Se acabar
If Err.Number <> 0 Then
MsgBox "Não foi possível excluir o arquivo existente. Certifique-se de que o arquivo não esteja aberto ou protegido contra gravação." _
& vbCrLf & vbCrLf & "Pressione OK para sair desta macro.", vbCritical, "Não foi possível excluir o arquivo"
Exit Sub
Se acabar
Se acabar

Definir xUsedRng = xSht.UsedRange
Se Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Then
'Salvar como arquivo PDF
xSht.ExportAsFixedFormat Tipo:=xlTypePDF, Nome do arquivo:=xFolder, Qualidade:=xlQualityStandard

'Cria e-mail do Outlook
Set xOutlookObj = CreateObject("Outlook.Application")
Definir xEmailObj = xOutlookObj.CreateItem(0)
Com xEmailObj
.Exibição
.Para = ""
.CC = ""
.Assunto = xSht.Name + ".pdf"
.Anexos.Adicionar xFolder
Se DisplayEmail = False Então
'.Mandar
Se acabar
Terminar com
Outro
MsgBox "A planilha ativa não pode ficar em branco"
Exit Sub
Se acabar
End Sub
Este comentário foi feito pelo moderador no site
Oi,
Se eu tiver duas planilhas em arquivo e gostaria de executar esta macro em uma planilha (pressionando o botão), mas enviar outra, como posso obtê-la?
Este comentário foi feito pelo moderador no site
Olá, gostaria de salvá-lo em um determinado local de arquivo, com o nome baseado no valor da célula C30. Tentei algumas opções, mas continuo recebendo falhas.
Este comentário foi feito pelo moderador no site
Oi hein, O código abaixo talvez possa ajudar. Depois de executar o código, selecione uma determinada pasta para salvar o arquivo PDF, então uma caixa de diálogo aparecerá para você inserir o nome do arquivo. Sub Saveaspdfandsend()
'Atualizado por Extendoffice 20210209
Dim xSht As Planilha
Dim xFileDlg As FileDialog
Dim xFolder como String
Dim xYesouNo As Integer
Dim xOutlookObj como objeto
Dim xEmailObj como objeto
Dim xUsedRng As Range
Dim xStrName As String
Dim xV como variante

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

Se xFileDlg.Show = True Então
xFolder = xFileDlg.SelectedItems(1)
Outro
MsgBox "Você deve especificar uma pasta para salvar o PDF." & vbCrLf & vbCrLf & "Pressione OK para sair desta macro.", vbCritical, "Deve especificar a pasta de destino"
Exit Sub
Se acabar
xStrName = ""
xV = Application.InputBox("Digite o nome do arquivo:", "Kutools for Excel", , , , , , 2)
Se xV = Falso Então
Exit Sub
Se acabar
xStrName = xV
Se xStrName = "" Então
MsgBox ("Nenhum nome de arquivo inserido, saindo do processo!")
Exit Sub
Se acabar

xFolder = xFolder + "\" + xStrName + ".pdf"
'Verifica se o arquivo já existe
Se Len(Dir(xFolder)) > 0 Então
xYesorNo = MsgBox(xFolder & " já existe." & vbCrLf & vbCrLf & "Deseja substituir?", _
vbYesNo + vbQuestion, "O arquivo existe")
On Error Resume Next
Se xSim ou Não = vbSim Então
Matar xFolder
Outro
MsgBox "se você não substituir o PDF existente, não posso continuar." _
& vbCrLf & vbCrLf & "Pressione OK para sair desta macro.", vbCritical, "Sair da Macro"
Exit Sub
Se acabar
If Err.Number <> 0 Then
MsgBox "Não foi possível excluir o arquivo existente. Certifique-se de que o arquivo não esteja aberto ou protegido contra gravação." _
& vbCrLf & vbCrLf & "Pressione OK para sair desta macro.", vbCritical, "Não foi possível excluir o arquivo"
Exit Sub
Se acabar
Se acabar

Definir xUsedRng = xSht.UsedRange
Se Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Then
'Salvar como arquivo PDF
xSht.ExportAsFixedFormat Tipo:=xlTypePDF, Nome do arquivo:=xFolder, Qualidade:=xlQualityStandard

'Cria e-mail do Outlook
Set xOutlookObj = CreateObject("Outlook.Application")
Definir xEmailObj = xOutlookObj.CreateItem(0)
Com xEmailObj
.Exibição
.Para = ""
.CC = ""
.Assunto = xSht.Name + ".pdf"
.Anexos.Adicionar xFolder
Se DisplayEmail = False Então
'.Mandar
Se acabar
Terminar com
Outro
MsgBox "A planilha ativa não pode ficar em branco"
Exit Sub
Se acabar
End Sub
Este comentário foi feito pelo moderador no site
Obrigado por isso, isso é ótimo, mas eu quero que a planilha seja nomeada de acordo com a célula A1 na planilha 1. o local para salvar conforme A1 na planilha 2, por exemplo, C:\Users\peete\Dropbox\Screenshots e enviar e-mail para endereço de e-mail na folha A3 2 o que eu já resolvi.
Este comentário foi feito pelo moderador no site
Obrigado por isso, isso é ótimo, mas eu quero que a planilha seja nomeada de acordo com a célula A1 na planilha 1. o local para salvar conforme A1 na planilha 2, por exemplo, C:\Users\peete\Dropbox\Screenshots, mas pode mudar quando usando o arquivo, e e-mail envie para o endereço de e-mail na folha A3 2 o que eu já resolvi.
Este comentário foi feito pelo moderador no site
Hi cristal , excelente código obrigado por compartilhar. Existe uma maneira de selecionar várias planilhas (da mesma pasta de trabalho) para salvar cada uma como um PDF independente e depois enviá-las todas anexadas em um e-mail?
Este comentário foi feito pelo moderador no site
Oi, O código VBA abaixo pode fazer um favor, por favor, tente. Na décima segunda linha do código, substitua os nomes das planilhas pelos nomes das planilhas reais no seu caso.
Sub Saveaspdfandsend1()
Dim xSht As Planilha
Dim xFileDlg As FileDialog
Dim xFolder como String
Dim xSimouNão, I, xNum As Integer
Dim xOutlookObj como objeto
Dim xEmailObj como objeto
Dim xUsedRng As Range
Dim xArrShetts como variante
Dim xPDFNameAddress como String
Dim xStr As String
xArrShetts = Array("teste", "Folha1", "Folha2") 'Digite os nomes das planilhas que você enviará como arquivos pdf entre aspas e separe-os com vírgula. Certifique-se de que não haja caracteres especiais como \/:"*<>| no nome do arquivo.

Para I = 0 Para UBound(xArrShetts)
On Error Resume Next
Definir xSht = Application.ActiveWorkbook.Worksheets(xArrShetts(I))
Se xSht.Name <> xArrShetts(I) Então
MsgBox "Planilha não encontrada, operação de saída:" & vbCrLf & vbCrLf & xArrShetts(I), vbInformation, "Kutools for Excel"
Exit Sub
Se acabar
Seguinte


Definir xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
Se xFileDlg.Show = True Então
xFolder = xFileDlg.SelectedItems(1)
Outro
MsgBox "Você deve especificar uma pasta para salvar o PDF." & vbCrLf & vbCrLf & "Pressione OK para sair desta macro.", vbCritical, "Deve especificar a pasta de destino"
Exit Sub
Se acabar
'Verifica se o arquivo já existe
xYesorNo = MsgBox("Se existirem arquivos com o mesmo nome na pasta de destino, o sufixo numérico será adicionado ao nome do arquivo automaticamente para distinguir as duplicatas" & vbCrLf & vbCrLf & "Clique em Sim para continuar, clique em Não para cancelar", _
vbYesNo + vbQuestion, "O arquivo existe")
If xYesorNo <> vbYes Então Exit Sub
Para I = 0 Para UBound(xArrShetts)
Definir xSht = Application.ActiveWorkbook.Worksheets(xArrShetts(I))

xStr = xFolder & "\" & xSht.Name & ".pdf"
xNúm = 1
Enquanto não (Dir(xStr, vbDirectory) = vbNullString)
xStr = xFolder & "\" & xSht.Name & "_" & xNum & ".pdf"
xNum = xNum + 1
Wend
Definir xUsedRng = xSht.UsedRange
Se Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Then
xSht.ExportAsFixedFormat Tipo:=xlTypePDF, Nome do arquivo:=xStr, Qualidade:=xlQualityStandard
Outro

Se acabar
xArrShetts(I) = xStr
Seguinte

'Cria e-mail do Outlook
Set xOutlookObj = CreateObject("Outlook.Application")
Definir xEmailObj = xOutlookObj.CreateItem(0)
Com xEmailObj
.Exibição
.Para = ""
.CC = ""
.Assunto = "????"
Para I = 0 Para UBound(xArrShetts)
.Anexos.Adicionar xArrShetts(I)
Seguinte
Se DisplayEmail = False Então
'.Mandar
Se acabar
Terminar com
End Sub
Este comentário foi feito pelo moderador no site
Oi, A única mudança com a qual estou lutando é criar um e-mail separado para cada documento pdf criado.
Este comentário foi feito pelo moderador no site
Oi, Para criar um e-mail separado para cada documento pdf, você pode executar manualmente o VBA fornecido na postagem em diferentes planilhas para fazê-lo.
Este comentário foi feito pelo moderador no site
Eu tenho mais de 100 planilhas na pasta de trabalho, o que implicará que eu tenha que executar o VBA mais de 100 vezes, o que é demorado.  
Consegui dividir minha pasta de trabalho em várias planilhas e, em seguida, posso converter cada planilha em um documento PDF individual.
A solução que estou procurando é enviar por e-mail cada documento PDF separadamente enquanto o processo acima estiver em execução.
Aqui está o VBA que estou executando atualmente:
SubSalvarcomopdfeenviar1()
Dim xSht As Planilha
Dim xFileDlg As FileDialog
Dim xFolder como String
Dim xSimouNão, I, xNum As Integer
Dim xOutlookObj como objeto
Dim xEmailObj como objeto
Dim xUsedRng As Range
Dim xArrShetts como variante
Dim xPDFNameAddress como String
Dim xStr As String
xArrShetts = Array("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") 'Digite os nomes das planilhas que você enviará como arquivos pdf entre aspas e separe-os com vírgula. Certifique-se de que não haja caracteres especiais como \/:"*<>| no nome do arquivo.

Para I = 0 Para UBound(xArrShetts)
On Error Resume Next
Definir xSht = Application.ActiveWorkbook.Worksheets(xArrShetts(I))
Se xSht.Name <> xArrShetts(I) Então
MsgBox "Planilha não encontrada, operação de saída:" & vbCrLf & vbCrLf & xArrShetts(I), vbInformation, "Kutools for Excel"
Exit Sub
Se acabar
Seguinte


Definir xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
Se xFileDlg.Show = True Então
xFolder = xFileDlg.SelectedItems(1)
Outro
MsgBox "Você deve especificar uma pasta para salvar o PDF." & vbCrLf & vbCrLf & "Pressione OK para sair desta macro.", vbCritical, "Deve especificar a pasta de destino"
Exit Sub
Se acabar
'Verifica se o arquivo já existe
xYesorNo = MsgBox("Se existirem arquivos com o mesmo nome na pasta de destino, o sufixo numérico será adicionado ao nome do arquivo automaticamente para distinguir as duplicatas" & vbCrLf & vbCrLf & "Clique em Sim para continuar, clique em Não para cancelar", _
vbYesNo + vbQuestion, "O arquivo existe")
If xYesorNo <> vbYes Então Exit Sub
Para I = 0 Para UBound(xArrShetts)
Definir xSht = Application.ActiveWorkbook.Worksheets(xArrShetts(I))

xStr = xFolder & "\" & xSht.Name & ".pdf"
xNúm = 1
Enquanto não (Dir(xStr, vbDirectory) = vbNullString)
xStr = xFolder & "\" & xSht.Name & "_" & xNum & ".pdf"
xNum = xNum + 1
Wend
Definir xUsedRng = xSht.UsedRange
Se Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Then
xSht.ExportAsFixedFormat Tipo:=xlTypePDF, Nome do arquivo:=xStr, Qualidade:=xlQualityStandard
Outro

Se acabar
xArrShetts(I) = xStr
Seguinte

'Cria e-mail do Outlook
Set xOutlookObj = CreateObject("Outlook.Application")
Definir xEmailObj = xOutlookObj.CreateItem(0)
Com xEmailObj
.Exibição
.To = "Ctracklegal@ctrack.com"
.CC = ""
.Assunto = "????"
Para I = 0 Para UBound(xArrShetts)
On Error Resume Next
.Anexos.Adicionar xArrShetts(I)
Seguinte
Se DisplayEmail = False Então
.Mandar
Exit Sub
Se acabar
Terminar com


End Sub
Este comentário foi feito pelo moderador no site
Olá @cristal
Isso é fabuloso - a principal coisa com a qual estou lutando é o nome do arquivo - gostaria que o nome do arquivo fosse extraído de uma célula na planilha em vez de usar o nome da guia. Já editei o código para salvar automaticamente em uma pasta especificada, mas estou lutando com o nome do arquivo.
Alguma ajuda que possa oferecer por favor?
Este comentário foi feito pelo moderador no site
Oi Tori,Se você quiser nomear o arquivo PDF com um valor de célula específico, tente o seguinte código.Depois de executar o código e selecionar uma pasta para salvar o arquivo, outra caixa de diálogo aparecerá, selecione a célula que você usará o valor como o nome do arquivo PDF e clique em OK para finalizar.
Sub Saveaspdfandsend2()
'Atualizado por Extendoffice 20210521
Dim xSht As Planilha
Dim xFileDlg As FileDialog
Dim xFolder como String
Dim xYesouNo As Integer
Dim xOutlookObj como objeto
Dim xEmailObj como objeto
Dim xUsedRng, xRgInser como intervalo
Dim xB como booleano
Definir xSht = ActiveSheet
Definir xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

Se xFileDlg.Show = True Então
xFolder = xFileDlg.SelectedItems(1)
Outro
MsgBox "Você deve especificar uma pasta para salvar o PDF." & vbCrLf & vbCrLf & "Pressione OK para sair desta macro.", vbCritical, "Deve especificar a pasta de destino"
Exit Sub
Se acabar
xB = Verdadeiro
On Error Resume Next
Enquanto xB
Definir xRgInser = Nada
Set xRgInser = Application.InputBox("Selecione uma célula que você usará o valor para nomear o arquivo PDF:", "Kutools for Excel", , , , , , 8)
Se xRgInser não é nada, então
MsgBox " Nenhuma célula selecionada, saia da operação!", vbInformation, "Kutools for Excel"
Exit Sub
Se acabar
Se xRgInser.Text = "" Então
MsgBox " A célula selecionada está em branco, por favor selecione novamente!", vbInformation, "Kutools for Excel"
Outro
xB = Falso
Se acabar
Wend

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

'Verifica se o arquivo já existe
Se Len(Dir(xFolder)) > 0 Então
xYesorNo = MsgBox(xFolder & " já existe." & vbCrLf & vbCrLf & "Deseja substituir?", _
vbYesNo + vbQuestion, "O arquivo existe")
On Error Resume Next
Se xSim ou Não = vbSim Então
Matar xFolder
Outro
MsgBox "se você não substituir o PDF existente, não posso continuar." _
& vbCrLf & vbCrLf & "Pressione OK para sair desta macro.", vbCritical, "Sair da Macro"
Exit Sub
Se acabar
If Err.Number <> 0 Then
MsgBox "Não foi possível excluir o arquivo existente. Certifique-se de que o arquivo não esteja aberto ou protegido contra gravação." _
& vbCrLf & vbCrLf & "Pressione OK para sair desta macro.", vbCritical, "Não foi possível excluir o arquivo"
Exit Sub
Se acabar
Se acabar

Definir xUsedRng = xSht.UsedRange
Se Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Then
'Salvar como arquivo PDF
xSht.ExportAsFixedFormat Tipo:=xlTypePDF, Nome do arquivo:=xFolder, Qualidade:=xlQualityStandard

'Cria e-mail do Outlook
Set xOutlookObj = CreateObject("Outlook.Application")
Definir xEmailObj = xOutlookObj.CreateItem(0)
Com xEmailObj
.Exibição
.Para = ""
.CC = ""
.Assunto = xSht.Name + ".pdf"
.Anexos.Adicionar xFolder
Se DisplayEmail = False Então
'.Mandar
Se acabar
Terminar com
Outro
MsgBox "A planilha ativa não pode ficar em branco"
Exit Sub
Se acabar
End Sub
Este comentário foi feito pelo moderador no site
Oi, eu precisava de algo semelhante, então aqui está o que eu tenho. Ele pega a data atual e cria uma nova pasta com o nome da data em um local específico. Ele coloca o pdf dentro desse novo local e anexa o pdf em um novo e-mail. Funciona como um mimo. Eu sou apenas um iniciante, então por favor me desculpe se parece uma bagunça. :D
Sub PDFTOEMAIL()
Dim xSht As Planilha
Dim xFileDlg As FileDialog
Dim xFolder como String
Dim xYesouNo As Integer
Dim xOutlookObj como objeto
Dim xEmailObj como objeto
Dim xUsedRng As Range
Dim xPath como string
Dim xOutMsg As String
Dim sFolderName como string, sFolder como string
Dim sFolderPath como String

Definir xSht = ActiveSheet
xFileDate = Format(Agora, "dd-mm-aaaa")
sFolder = "C:" 'aqui é onde você tem uma pasta principal
sFolderName = "Fim da semana " + Format(Now, "dd-mm-yyyy") 'pasta a ser criada na pasta principal com o nome Fim da semana e data atual
sFolderPath = "C:" & sFolderName 'main folder novamente para criar o novo caminho incluindo a nova pasta
Set oFSO = CreateObject("Scripting.FileSystemObject")
Se oFSO.FolderExists(sFolderPath) Então
MsgBox "A pasta já existe!" & vbCrLf & vbCrLf & sFolderPath, vbInformation, "INFO"
Outro
MkDir sFolderPath
MsgBox "Nova pasta foi criada!" & vbCrLf & vbCrLf & sFolderPath, vbInformation, "INFO"
Se acabar
xPath = sFolderPath
xFolder = xPath + "\" + xSht.Name + "_" + xFileDate + ".pdf"
Se Len(Dir(xFolder)) > 0 Então
xYesorNo = MsgBox(xFolder & " já existe." & vbCrLf & vbCrLf & "Deseja substituir?", _
vbYesNo + vbQuestion, "O arquivo existe")
On Error Resume Next
Se xSim ou Não = vbSim Então
Matar xFolder
Outro
MsgBox "se você não substituir o PDF existente, não posso continuar." _
& vbCrLf & vbCrLf & "Pressione OK para sair desta macro.", vbCritical, "Sair da Macro"
Exit Sub
Se acabar
If Err.Number <> 0 Then
MsgBox "Não foi possível excluir o arquivo existente. Certifique-se de que o arquivo não esteja aberto ou protegido contra gravação." _
& vbCrLf & vbCrLf & "Pressione OK para sair desta macro.", vbCritical, "Não foi possível excluir o arquivo"
Exit Sub
Se acabar
Se acabar

Definir xUsedRng = xSht.UsedRange
Se Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Then
xSht.ExportAsFixedFormat Tipo:=xlTypePDF, Nome do arquivo:=xFolder, Qualidade:=xlQualityStandard
Set xOutlookObj = CreateObject("Outlook.Application")
Definir xEmailObj = xOutlookObj.CreateItem(0)
xOutMsg = " Por favor, encontre em anexo Este e-mail e anexo foram gerados automaticamente "
'adiciona uma nota que o email foi gerado automaticamente

Com xEmailObj
.Exibição
.To = "" 'adicione seus próprios e-mails
.CC = ""
.Assunto = xSht.Name + " PDF para final de semana " + xFileDate + " - Local " ' assunto inclui nome da planilha, pdf, data e local, isso pode ser editado conforme necessário
.Anexos.Adicionar xFolder
.HTMLBody = xOutMsg & .HTMLBody
Se DisplayEmail = False Então
'.Send <--- Aqui se você excluir o apóstrofo o email será enviado automaticamente, então tenha cuidado
Se acabar
Terminar com
Outro
MsgBox "A planilha ativa não pode ficar em branco"
Exit Sub
Se acabar
End Sub
Este comentário foi feito pelo moderador no site
Como faço para editar este código para salvar apenas células ("a1:r99") para salvar como PDF. Tenho coisas extras nas laterais que não quero no meu documento PDF.
Sub Salvar como PDF e enviar ()
'Atualizado por Extendoffice 20210209
Dim xSht As Planilha
Dim xFileDlg As FileDialog
Dim xFolder como String
Dim xYesouNo As Integer
Dim xOutlookObj como objeto
Dim xEmailObj como objeto
Dim xUsedRng As Range
Dim xStrName As String
Dim xV como variante

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

Se xFileDlg.Show = True Então
xFolder = xFileDlg.SelectedItems(1)
Outro
MsgBox "Você deve especificar uma pasta para salvar o PDF." & vbCrLf & vbCrLf & "Pressione OK para sair desta macro.", vbCritical, "Deve especificar a pasta de destino"
Exit Sub
Se acabar
xStrName = ""
xV = Application.InputBox("Digite o nome do arquivo:", "Kutools for Excel", , , , , , 2)
Se xV = Falso Então
Exit Sub
Se acabar
xStrName = xV
Se xStrName = "" Então
MsgBox ("Nenhum nome de arquivo inserido, saindo do processo!")
Exit Sub
Se acabar

xFolder = xFolder + "\" + xStrName + ".pdf"
'Verifica se o arquivo já existe
Se Len(Dir(xFolder)) > 0 Então
xYesorNo = MsgBox(xFolder & " já existe." & vbCrLf & vbCrLf & "Deseja substituir?", _
vbYesNo + vbQuestion, "O arquivo existe")
On Error Resume Next
Se xSim ou Não = vbSim Então
Matar xFolder
Outro
MsgBox "se você não substituir o PDF existente, não posso continuar." _
& vbCrLf & vbCrLf & "Pressione OK para sair desta macro.", vbCritical, "Sair da Macro"
Exit Sub
Se acabar
If Err.Number <> 0 Then
MsgBox "Não foi possível excluir o arquivo existente. Certifique-se de que o arquivo não esteja aberto ou protegido contra gravação." _
& vbCrLf & vbCrLf & "Pressione OK para sair desta macro.", vbCritical, "Não foi possível excluir o arquivo"
Exit Sub
Se acabar
Se acabar

Definir xUsedRng = xSht.UsedRange
Se Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Then
'Salvar como arquivo PDF
xSht.ExportAsFixedFormat Tipo:=xlTypePDF, Nome do arquivo:=xFolder, Qualidade:=xlQualityStandard

'Cria e-mail do Outlook
Set xOutlookObj = CreateObject("Outlook.Application")
Definir xEmailObj = xOutlookObj.CreateItem(0)
Com xEmailObj
.Exibição
.Para = ""
.CC = ""
.Assunto = xSht.Name + ".pdf"
.Anexos.Adicionar xFolder
Se DisplayEmail = False Então
'.Mandar
Se acabar
Terminar com
Outro
MsgBox "A planilha ativa não pode ficar em branco"
Exit Sub
Se acabar
End Sub
Este comentário foi feito pelo moderador no site
Olá, acabei de testar este código em uma de minhas planilhas e tenho as áreas de impressão definidas para que as coisas extras na parte inferior não apareçam no pdf. Tente!
Este comentário foi feito pelo moderador no site
Hi
Muito obrigado pelo código, mas é possível salvar o PDF automaticamente no mesmo local do arquivo ativo do Excel e com o mesmo nome do arquivo ativo do Excel?
Muito obrigado.
Haste
Não há comentários postados aqui ainda
carregar mais
Deixe o seu comentário
Postando como convidado
×
Avalie esta postagem:
0   Personagens
Locais sugeridos

Siga-nos

Copyright © 2009 - www.extendoffice.com. | Todos os direitos reservados. Distribuído por ExtendOffice. | | | Mapa do site
Microsoft e o logotipo do Office são marcas comerciais ou marcas registradas da Microsoft Corporation nos Estados Unidos e / ou em outros países.
Protegido por Sectigo SSL