Bom dia pessoal,
Estou com um código aqui, vou explicar ele primeiro:
Tiro o print de um UserForm, salvo em uma pasta da rede e depois colo ele no corpo do e-mail. Até ai tudo certo, só meu problema é que quando ele tira o print e faz os processos, salva o caminho que foi salvo em uma célula do Excel, para ser mais preciso,
na célula que estava selecionada. Não quero que isso aconteça, pois quando salva, substitui o conteúdo que tem na célula...
Segue código:
Dim cob As Excel.ChartObject
Dim wks As Excel.Worksheet
Dim shp As Excel.Shape
Dim cht As Excel.Chart
Dim objOutlook As Object 'Outlook.Application
Dim objMailItem As Object 'Outlook.MailItem
Dim strImagePath As String
'___________________________
strImagePath = Environ("save") & "M:\GEF-NOVO\10 Logistica\05 - Central\Agendamento de Prancha\Imagens - Novo Agendamento\PrintsNew\print.jpg" 'Local onde vai ser salvo
Application.SendKeys "(%{1068})", True
DoEvents
Application.Wait Now + TimeSerial(0, 0, 1)
Selection = strImagePath
Application.ScreenUpdating = False
Set wks = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
wks.Paste
Set shp = wks.Shapes(1)
Set cht = wks.ChartObjects.Add(0, 0, shp.Width, shp.Height).Chart
cht.Paste
cht.Export strImagePath, "jpg"
wks.Parent.Close savechanges:=False
Application.ScreenUpdating = True
'tratar imagens para inserir no email
Dim imagem, arrImagens
'celula onde colocamos a localização da imagem
imagem = Plan4.Cells(6, 1)
If Len(imagem) > 0 Then
arrImagens = Split(imagem, ";")
imagem = "<p>Imagem</p>"
For i = LBound(arrImagens) To UBound(arrImagens)
If Dir(arrImagens(i)) <> "" Then
imagem = "<p><img src=""cid:" & Environ(arrImagens(i)) & """ /></p>"
End If
Next i
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = "fcvelho@klabin.com.br"
.cc = ""
.BCC = ""
.Subject = "Agendamento de pranchas"
.Attachments.Add "M:\GEF-NOVO\10 Logistica\05 - Central\Agendamento de Prancha\Imagens - Novo Agendamento\PrintsNew\print.jpg"
.Attachments.Add arrImagens(i)
.HTMLBody = "<A1>" & "Segue nova solicitação para agendamento de prancha: " & "</A1>" & "<BR><BR>" & _
vbLf & "Solicitante: " & tb_solicitante.Text & vbLf & "<BR>" & _
"Máquina: " & tb_maquina.Text & vbLf & "<br>" & _
"Ordem: " & TextBox17.Text & vbLf & "<br>" & _
"Origem: " & cb_origem.Text & vbLf & "<br>" & _
"Destino: " & cb_destino.Text & vbLf & "<br>" & _
"Responsável: " & ComboBox20.Text & vbLf & "<BR>" & _
"Observação: " & tb_observacao.Text & vbLf & "<br><br>" & vbLf & "<br><br>" & _
"Agendamento: " & imagem
.Send 'or use .Display
End With
Set OutMail = Nothing
Set OutApp = Nothing
Nesse mesmo código, encontro outro problema... Ele desativa o NumLook :s
Obrigado pela atenção pessoal.
Att.