- 22 Jul 2021 às 19:03
#65939
Pessoal,
Boa noite! alguem consegue me ajudar estou tentando unificar dois códigos VBA em uma única planilha para facilitar o envio por e-mail. ambos os cód. funcionam bem, mas não estou conseguindo estruturar os dois em um só arquivo.
vamos lá.
O primeiro cód é esse:
Private Sub Botão6_Clique()
Dim W As Worksheet
Dim pasta As String
Dim nome_arquivo As String
Application.DisplayAlerts = False
Sheet = Worksheets("EMISSÃO").Select
Range("A2").Select
Do While ActiveCell.Value <> ""
Selection.Copy
Sheets("Relatório").Select
Range("i7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Realiza o filtro
ActiveWindow.SmallScroll Down:=-3
ActiveSheet.AutoFilter.ApplyFilter
' Salva PDF
'Pasta que o arquivo vai ser salvo - Coloque sempre a barra no final \.
pasta = Range("A1").Value
'Nome a ser dado ao Arquivo - Coloque o nome mais a extensão como no exemplo (nome_do_arquivo.xlsx)
nome_arquivo = Range("B1").Value
'Rotina que SALVA o Arquivo no local escolhido
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=pasta & nome_arquivo _
Sheet = Worksheets("EMISSÃO").Select
ActiveCell.Offset(1, 0).Select
Loop
Sheet = Worksheets("DECLARAÇÃO").Select
Application.DisplayAlerts = True
If MsgBox("Relação de funcionários salva com sucesso, informações retiradas da base do checklist, arquivos salvos em PDF no diretório onde se encontra esta planilha", vbOKOnly, "Relação Salva com Sucesso") = vbNo Then
End If
End Sub
Ele busca uma relação de funcionários e salva um arquivo em PDF, quero que após salvar esse arquivo em PDF ele já envie por e-mail para o gestor responsável, e fique em LOOP.
o Segundo cód que estou usando é esse:
Set objeto_outlook = CreateObject("Outlook.Application")
Set Email = objeto_outlook.createitem(0)
Email.display
Email.to = Cells(2, 1).Value
Email.cc = "chefe@gmail.com"
Email.bcc = "diego@gmail.com"
Email.Subject = "Relatório de Vendas"
Email.Body = Cells(2, 2).Value & "," & Chr(10) & Chr(10) _
& Cells(2, 3).Value & Chr(10) & Chr(10) _
& "Abraços," & Chr(10) & "Diego Amorim"
Email.Attachments.Add (ThisWorkbook.Path & "\Vendas - " & Cells(2, 2).Value & ".xlsx")
Email.send
End Sub
Boa noite! alguem consegue me ajudar estou tentando unificar dois códigos VBA em uma única planilha para facilitar o envio por e-mail. ambos os cód. funcionam bem, mas não estou conseguindo estruturar os dois em um só arquivo.
vamos lá.
O primeiro cód é esse:
Private Sub Botão6_Clique()
Dim W As Worksheet
Dim pasta As String
Dim nome_arquivo As String
Application.DisplayAlerts = False
Sheet = Worksheets("EMISSÃO").Select
Range("A2").Select
Do While ActiveCell.Value <> ""
Selection.Copy
Sheets("Relatório").Select
Range("i7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Realiza o filtro
ActiveWindow.SmallScroll Down:=-3
ActiveSheet.AutoFilter.ApplyFilter
' Salva PDF
'Pasta que o arquivo vai ser salvo - Coloque sempre a barra no final \.
pasta = Range("A1").Value
'Nome a ser dado ao Arquivo - Coloque o nome mais a extensão como no exemplo (nome_do_arquivo.xlsx)
nome_arquivo = Range("B1").Value
'Rotina que SALVA o Arquivo no local escolhido
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=pasta & nome_arquivo _
Sheet = Worksheets("EMISSÃO").Select
ActiveCell.Offset(1, 0).Select
Loop
Sheet = Worksheets("DECLARAÇÃO").Select
Application.DisplayAlerts = True
If MsgBox("Relação de funcionários salva com sucesso, informações retiradas da base do checklist, arquivos salvos em PDF no diretório onde se encontra esta planilha", vbOKOnly, "Relação Salva com Sucesso") = vbNo Then
End If
End Sub
Ele busca uma relação de funcionários e salva um arquivo em PDF, quero que após salvar esse arquivo em PDF ele já envie por e-mail para o gestor responsável, e fique em LOOP.
o Segundo cód que estou usando é esse:
Set objeto_outlook = CreateObject("Outlook.Application")
Set Email = objeto_outlook.createitem(0)
Email.display
Email.to = Cells(2, 1).Value
Email.cc = "chefe@gmail.com"
Email.bcc = "diego@gmail.com"
Email.Subject = "Relatório de Vendas"
Email.Body = Cells(2, 2).Value & "," & Chr(10) & Chr(10) _
& Cells(2, 3).Value & Chr(10) & Chr(10) _
& "Abraços," & Chr(10) & "Diego Amorim"
Email.Attachments.Add (ThisWorkbook.Path & "\Vendas - " & Cells(2, 2).Value & ".xlsx")
Email.send
End Sub
