Ir ao conteúdo
Regras do Clube do Hardware

Macro que salva em pdf e manda email

ffilgueira1000

Por ffilgueira1000
em Microsoft Office e similares

Posts recomendados

ffilgueira1000
 

ffilgueira1000

Postado
Postado

amigos do ch, se for possivel me ajudem em uma coisa.

trabalho com uma planilha em excel2010 tem umas 300 linhas e umas 50 colunas, eu faço o seguinte, ajusto a area de impressao na 'quebra de pagina' imprimo em uma impressora virtual que transforma isso em pdf, salvo em um local qualquer e depois mando por email para meus clientes, so que faço isso umas 300 vezes por dia, e da um trabalhao...

sera que existe uma macro que faça o seguinte, atraves de um botao 'enviar pdf por email' a area de impressao ajustada com a 'quebra de pagina' seja transformada em pdf e ja abra o microsoft outlook com a mensagem anexada e o endereço de email certo pra envio, supondo que o endereço de email esteja na celula AC12 no formato texto (nao esta em hiperlink)

Eu tentei fazer isso atraves do comando 'salvar e enviar' do menu iniciar... mas quando abro o pdf gerado, esta la dentro toda a planilha, e eu preciso que o pdf seja gerado somente com a area de impressao da 'quebra de pagina' que vai variar de acordo com as linhas e coluna que eu ajustar.

Sera que é possivel isso?

Segue uma amostra da planilha que uso:

http://www.sendspace.com/file/2gsw4w

nahrv
 

nahrv

Postado
Postado

hey, não vou conseguir testar porque to sem recursos pra isso, mas já tentou gravar uma macro fazendo isso?? o email teria que mandar pelo outlook eu imagino, aí só editar a parte do endereço atribuindo ele a uma variável.

e para ficar na barra de ferramentas, num botão, é assim:

você grava a macro e a armazena na pasta de trabalho pessoal de macros.

http://www.sendspace.com/file/dy8nnq

Aí, vai em 'Personalizar faixa de opções' e adiciona um botão com a macro que você gravou!!

http://www.sendspace.com/file/7f5fv0

tenta aí e qualquer coisa me avisa, ok??

ffilgueira1000
 

ffilgueira1000

Postado
  • Autor
Postado

Realmente o caso é parecido com o meu... mas devido a minha falta de habilidade com macros não consegui usar as informações a meu favor... sera que alguem ae pode me ajudar?

Não quero que a macro salve o arquivo excel... eu mesmo vou salvarcomo em um local de acordo com o tipo do cliente.

Preciso que a macro gere uma arquivo em pdf com a area de impressao selecionada na quebra de pagina, e ja anexe esse arquivo automaticamente no envio de mensagens do outlook ja com o endereço de email na linha 'para'.

utilizo aqui excel e microsoft outlook 2010

o nome do arquivo pdf deve ser igual a celula AH15

o endereço de email esta na celula AC12 em formato texto

nahrv
 

nahrv

Postado
Postado

faz como eu disse..faça os procedimentos, enviando pra um email 'teste' e gravando a macro..aí vamos ver o que sai! me passa o código que eu vejo se da pra adaptar!!

ffilgueira1000
 

ffilgueira1000

Postado
  • Autor
Postado

Hei nahrv... desculpe a ignorância... mas eu não tenho o código e também não sei cria-lo pois nao manjo nada de vba... gostaria que alguem me ajudasse elaborando esse código... dai eu testo aqui... e vou informando caso haja algum erro.

Será que podem me ajudar?

nahrv
 

nahrv

Postado
Postado

huehue...se acha que eu sei todos os códigos de cabeça?? Não precisa saber o código não!! É só GRAVAR a macro que o excel faz o código sozinho imitando o que você fez na gravação!! aí você edita a macro gravada e o que você quer mudar do código, muda! sacou??

http://www.sendspace.com/file/uueq07

1 - clicar em 'gravar macro'

2 - dar um nome à sua macro e, se quiser, escolher um atalho para o teclado e uma descrição e fazer os procedimentos que você quer executar

3 - clicar em 'parar gravação'

4 - exibir macros

5 - selecionar a macro que você fez e clicar em editar.

Isso vai te levar ao código, que você pode editar o quanto quiser!

nahrv
 

nahrv

Postado
Postado

YES, U CAN!! rs

Manda bala e manda o código pra gente aqui!! Pode ser que de errado, maaaas...

obs: manda o email pelo outlook, ok??

ffilgueira1000
 

ffilgueira1000

Postado
  • Autor
Postado

Desistooooooooooooooooo, esse negocio de vba num é pra mim nao... tenho que me contentar a copiar e adaptar codigos que acho por ae... kkk...

Tentei gerar o codigo mas nao sai do inicio do começo... é uma vergonha...

Bom... ate descobrir uma maneira mais "profissional" de fazer o que preciso, estou me virando assim: oculto as linhas e colunas que nao desejo, e oculto tambem as planilhas que nao desejo salvar em pdf, depois utilizo o comando 'salvar e enviar' do menu 'arquivo' que gera um pdf somente do que nao esta oculto e ja abre a caixa de envio de email com o pdf anexado.

Da um trabalhao... mas por hora atende!

valeu galera.

ffilgueira1000
 

ffilgueira1000

Postado
  • Autor
Postado

você e os colegas do CH sempre me ajudando hein...

Vou testar aqui e mantenho vocês informados!

valeu...

Hei nahrv, muito obrigado pela ajuda, mas estou com dificuldade nos seguintes itens, veja se você ou alguem ae pode me ajudar por favor:

1) eu preciso adaptar o código a minha planilha, e não estou conseguindo instalar o 'botao' de 'impressao e envio'.

2) o código salva o pdf e ja envia automaticamente pelo outlook, ate ai beleza... mas o problema é que o destinatario do email é sempre o que esta indicado no código!(eu marquei em vermelho pra você ver).

Eu queria que o código mandasse o email para o endereço que estivesse na celula AC12 da planilha 'Cotação' por exemplo, ou então, que abrisse uma janela ou algo assim pra mim digitar o endereço de email.

Segue o código:

Módulo 1)

Sub ImprimirComoPDF_e_EnviarViaOutlook()

Dim myobject As New Bullzip.PDFPrinterSettings

Dim SavePath As String, FileName As String

Dim myOlApp, myItem, myAttachments

'-----------------------------------------------------------------------------------------------------------

'1ª parte do código: salvar um arquivo PDF com o mesmo nome e no mesmo diretório do arquivo excel original

'contendo a área selecionada de uma planilha

'-----------------------------------------------------------------------------------------------------------

FileName = ThisWorkbook.Path & "\" & Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".") - 1) & ".pdf"

With myobject

.SetValue "output", SavePath & FileName

.SetValue "showsettings", "never"

.WriteSettings (True)

End With

'Modificando a impressora para Bullzip...

If InStr(ActivePrinter, "Bullzip") = 0 Then

Dim storeprinter$, PrinterChanged As Boolean

PrinterChanged = True

storeprinter = ActivePrinter

ActivePrinter = GetFullNetworkPrinterName("Bullzip")

End If

Selection.PrintOut

Caixa = MsgBox("Confirme se o arquivo PDF foi salvo antes de prosseguir.", vbYesNo + vbQuestion, "Exportação PDF")

If Caixa = vbNo Then Exit Sub

If PrinterChanged Then ActivePrinter = storeprinter

'-----------------------------------------------------------------------------------------------------------

'2ª parte do código: enviar o arquivo PDF criado na etapa anterior via e-mail como um anexo de mensagem

'-----------------------------------------------------------------------------------------------------------

Set myOlApp = CreateObject("Outlook.Application")

Set myItem = myOlApp.CreateItem(olMailItem)

Set myAttachments = myItem.Attachments

With myItem

.To = "adilsonsoledade@hotmail.com"

.Subject = "Envio de mensagem"

.Body = "Segue arquivo com as informações necessárias para continuidade do projeto"

.Save

myAttachments.Add FileName

.Send

End With

End Sub

Function GetFullNetworkPrinterName(strNetworkPrinterName As String) As String

'-----------------------------------------------------------------------------------------------------------

'Função para estabelecer Bullzip como impressora de destino para o PDF gerado

'-----------------------------------------------------------------------------------------------------------

' Retorna o nome completo da impressora da rede

' retorna um texto vazio se não for encontra da impressora

' i.e. GetFullNetworkPrinterName("HP LaserJet 8100 Series PCL")

' deve retornar "HP LaserJet 8100 Series PCL em Ne04:"

Dim strCurrentPrinterName As String, strTempPrinterName As String, i As Long

strCurrentPrinterName = Application.ActivePrinter

i = 0

Do While i < 100

strTempPrinterName = strNetworkPrinterName & " PDF Printer em Ne" & Format(i, "00") & ":"

On Error Resume Next

'Tentativa de estabelecer Bullzip como impressora ativa

Application.ActivePrinter = strTempPrinterName

On Error GoTo 0

If Application.ActivePrinter = strTempPrinterName Then

'Bullzip foi localizada

GetFullNetworkPrinterName = strTempPrinterName

i = 100 'atribuição para concluir o loop

End If

i = i + 1

Loop

'retorna para a impressora ativa original

Application.ActivePrinter = strCurrentPrinterName

End Function

Módulo 2)

Option Explicit

nahrv
 

nahrv

Postado
Postado

Quanto a colocar o botão:

...

você grava a macro e a armazena na pasta de trabalho pessoal de macros.

http://www.sendspace.com/file/dy8nnq

Aí, vai em 'Personalizar faixa de opções' e adiciona um botão com a macro que você gravou!!

http://www.sendspace.com/file/7f5fv0

...

Quanto ao endereço, segue código alterado:

Módulo 1)

Sub ImprimirComoPDF_e_EnviarViaOutlook()

Dim myobject As New Bullzip.PDFPrinterSettings

Dim SavePath As String, FileName As String

Dim myOlApp, myItem, myAttachments

Dim endereco As String

endereco = Sheets("Cotação").Range("AC12").Value

'-----------------------------------------------------------------------------------------------------------

'1ª parte do código: salvar um arquivo PDF com o mesmo nome e no mesmo diretório do arquivo excel original

'contendo a área selecionada de uma planilha

'-----------------------------------------------------------------------------------------------------------

FileName = ThisWorkbook.Path & "\" & Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".") - 1) & ".pdf"

With myobject

.SetValue "output", SavePath & FileName

.SetValue "showsettings", "never"

.WriteSettings (True)

End With

'Modificando a impressora para Bullzip...

If InStr(ActivePrinter, "Bullzip") = 0 Then

Dim storeprinter$, PrinterChanged As Boolean

PrinterChanged = True

storeprinter = ActivePrinter

ActivePrinter = GetFullNetworkPrinterName("Bullzip")

End If

Selection.PrintOut

Caixa = MsgBox("Confirme se o arquivo PDF foi salvo antes de prosseguir.", vbYesNo + vbQuestion, "Exportação PDF")

If Caixa = vbNo Then Exit Sub

If PrinterChanged Then ActivePrinter = storeprinter

'-----------------------------------------------------------------------------------------------------------

'2ª parte do código: enviar o arquivo PDF criado na etapa anterior via e-mail como um anexo de mensagem

'-----------------------------------------------------------------------------------------------------------

Set myOlApp = CreateObject("Outlook.Application")

Set myItem = myOlApp.CreateItem(olMailItem)

Set myAttachments = myItem.Attachments

With myItem

.To = endereco

.Subject = "Envio de mensagem"

.Body = "Segue arquivo com as informações necessárias para continuidade do projeto"

.Save

myAttachments.Add FileName

.Send

End With

End Sub

Function GetFullNetworkPrinterName(strNetworkPrinterName As String) As String

'-----------------------------------------------------------------------------------------------------------

'Função para estabelecer Bullzip como impressora de destino para o PDF gerado

'-----------------------------------------------------------------------------------------------------------

' Retorna o nome completo da impressora da rede

' retorna um texto vazio se não for encontra da impressora

' i.e. GetFullNetworkPrinterName("HP LaserJet 8100 Series PCL")

' deve retornar "HP LaserJet 8100 Series PCL em Ne04:"

Dim strCurrentPrinterName As String, strTempPrinterName As String, i As Long

strCurrentPrinterName = Application.ActivePrinter

i = 0

Do While i < 100

strTempPrinterName = strNetworkPrinterName & " PDF Printer em Ne" & Format(i, "00") & ":"

On Error Resume Next

'Tentativa de estabelecer Bullzip como impressora ativa

Application.ActivePrinter = strTempPrinterName

On Error GoTo 0

If Application.ActivePrinter = strTempPrinterName Then

'Bullzip foi localizada

GetFullNetworkPrinterName = strTempPrinterName

i = 100 'atribuição para concluir o loop

End If

i = i + 1

Loop

'retorna para a impressora ativa original

Application.ActivePrinter = strCurrentPrinterName

End Function

Módulo 2)

Option Explicit

explicação: http://www.sendspace.com/file/d9iyuj

se tiver problemas quanto ao botão, avise, ok??

nahrv
 

nahrv

Postado
Postado

quando der a msg de erro, aperte DEPURAR, que o sistema vai mostrar o que há de errado..me manda o print disso que o sistema apontar!!

nahrv
 

nahrv

Postado
Postado

Suspeitei desde o princípio! rs

por algum motivo que não sei qual, tá dando erro na hora de salvar o pdf ¬¬

a linha que define onde será salvo é essa:

FileName = ThisWorkbook.Path & "\" & Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".") - 1) & ".pdf"

Vamos tentar consertar...não sei se vai fazer diferença, mas beleza =D tenta escolher "na mão" a pasta onde o pdf será salvo! oh:

FileName = "C:\Meus Documentos\Pasta Tal\" & ThisWorkbook.Name & ".pdf"

Aí você troca C:\Meus Documentos\Pasta Tal pelo caminho onde você quer salvar.

Outra coisa: tá sempre salvando com o mesmo nome da planilha..você quer escolher uma célula pra dar nome?? se sim, substitui ThisWorkbook.Name por Range("A1").Value, por exemplo!

ffilgueira1000
 

ffilgueira1000

Postado
  • Autor
Postado

Eu ia te elogiar... mas quando testei novamente já desisti...kkk...

Alterei aqui e salvou beleza no novo caminho que defini e com o nome que estipulei tambem... manda puxar o nome do arquivo da celula AH15... e deu tudo certo...

Mas aparece a mesma mensagem de erro e quando clico em depurar, mostra o mesmo erro que lhe enviei...

Mas quando vou la na pasta onde o codigo esta salvando o arquivo... esta tudo certo... o arquivo esta la belezinha com o nome e tudo...

O que sera???

Pode parecer inutil vindo da minha parte, pois nao manjo nada... mas ao que me parece ta dando erro no momento de anexar o arquivo no outlook né?

Estranho que as mensagens nao ficam na caixa de saida... depois que aperto depurar... as mensagens vão para a pasta Rascunho...

nahrv
 

nahrv

Postado
Postado

meu...deve ser macumba! huahauhau

Manda de novo o cód todo pra eu dar uma outra olhada com as alterações q você fez?? n é possível!! kkk

ps: ah, outra dica..subject é o ASSUNTO do email e BODY é o que vai no corpo! você pode trocar o texto, colocar o valor de alguma célula ou as duas coisa se precisar!!

ex:

.Subject = "Envio de mensagem sobre " & Range("G500").Value

.Body = = "Segue arquivo referente ao coiso número " & Rande("G550").Value & "para sua análise."

nahrv
 

nahrv

Postado
Postado

entonces...n vou consegui testa porque n da pr eu instalar a PDF Printer aqui ^^"

(Y)

Meoo..são testes, tbn n tenho certeza, ok?

troca .SetValue "output", SavePath & FileName por .SetValue "output", FileName e ve o q dá! heuehue

  • 9 meses depois...
TiagoLima
 

TiagoLima

Postado
Postado

Prezados estava lendo o topico e adaptando o codigo para uma planilha minha, no entanto gostaria de envia-se a planilha completa sem precisar eu selecionar o que vou enviar.

Desculpa esta revivendo o topico.

Obrigado.

Arquivado

Este tópico foi arquivado e está fechado para novas respostas.

Ir à lista de tópicos

Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas comunidades sobre tecnologia do Brasil. Leia mais

Direitos autorais

Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

Mais

×
×
  • Criar novo...

LANÇAMENTO!

eletronica2025-popup.jpg


CLIQUE AQUI E BAIXE AGORA MESMO!