Tirar Print Screen e colar no e-mail

Question

Bom dia galera, estou com uma grande dúvida... Preciso de uma ajuda, estou desenvolvendo um controle de viagens por caminhões. O cliente faz a solicitação e eu tenho que confirmar se tenho um caminhão disponivel ou não. O que eu preciso é quando eu clicar no Botão de Comando, ele tire um printScreen da tela, abra o e-mail e cole, depois arrumo manual o e-mail do solicitante e envio mostrando a solicitação...

Desde já agradeço a ajuda. Obrigado!

Answer 1

Você está utilizando formulários ou o próprio Excel mesmo?

Considere usar um suplemento para envio de e-mails: http://www.ambienteoffice.com.br/suplementos/emailxl/

---

Felipe Costa Gualberto - http://www.ambienteoffice.com.br

Answer 2

Estou usando formularios.

Tenho o UserForm, e alguns TextBox onde contex valores. Em baixo tenho os botões de comando, "Ok" e "e-mail", preciso que quando eu clicar em e-mail ele faça um AltPrintScreen do UserForm e abra o Outlook e cole, eu arrumo o e-mail do solicitante e envio...

Answer 3

Você pode tirar um print do formulário utilizando o comando abaixo:

    Application.SendKeys "(^%{1068})"

E então ler a área de transferência, em que a imagem será salva.

Alternativamente, pode usar chamadas APIs para gravar um formulário como imagem: http://www.ambienteoffice.com.br/officevba/salvar_imagem_de_formulario_numa_pasta/

---

Felipe Costa Gualberto - http://www.ambienteoffice.com.br

Answer 4

Cara, eu sou muito amador nisso... Ja tentei e não consegui, poderia me dar uma mão no codigo a ser digitado?

Answer 5

Você está usando o Outlook para enviar e-mail?

---

Felipe Costa Gualberto - http://www.ambienteoffice.com.br

Answer 6

Sim Outlook,

Answer 7

Associe o código abaixo à um botão do seu formulário:

Private Sub CommandButton1_Click()
  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("temp") & "\benzatemp.png"

  Application.SendKeys "(%{1068})", True
  DoEvents
  Application.Wait Now + TimeSerial(0, 0, 1)
  
  Application.ScreenUpdating = False
  Unload Me
  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, "png"
  wks.Parent.Close SaveChanges:=False
  Application.ScreenUpdating = True
  
  Set objOutlook = CreateObject("Outlook.Application")
  Set objMailItem = objOutlook.CreateItem(0)
  With objMailItem
    .HTMLBody = "<img src='" & strImagePath & "' />"
    .To = "[e-mail]"
    .Subject = "Assunto"
    .CC = ""
    .Display
  End With
  
  Kill strImagePath
End Sub

---

Felipe Costa Gualberto - http://www.ambienteoffice.com.br

Answer 8

Cara, show de bola! Funcionou direitinho, muito obrigado.

Só deu um pequeno probleminha, talvez você saiba me responder... Quando vou preencher as caixa de textos como a de data, ele lê os dois primeiros digitos e pula para outra caixa de desabilita o Num Lock.

Abraço

Answer 9

Não entendi muito bem sua duvida.

Sua dúvida é referente ao código que forneci? Se não, poate o código que tem utilizado atualmente.

---

Felipe Costa Gualberto - http://www.ambienteoffice.com.br

Answer 10

Felipe, consegui!

Estava dando um problema de SandKeys, dae apaguei das outras caixa de texto e fiz uma nova aplicação para habilitar o NUMLOCK.

Private Sub MultiPage0_Change()

Application.SendKeys "({NumLock})"

End Sub

Mudei aqui tambem,

  strImagePath = Environ("Save") & "C:\Users\fcvelho\Desktop\Paraná\Print\fcvelho.png" 'Local onde vai ser salvo
  i = "C:\Users\fcvelho\Desktop\Paraná\Print\fcvelho.png"
  Application.SendKeys "(%{1068})"
  DoEvents
  Application.Wait Now + TimeSerial(0, 0, 1)
 
  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, "png"
  wks.Parent.Close SaveChanges:=False
  Application.ScreenUpdating = True
 
  Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
   
    On Error Resume Next
    With OutMail
    .To = "e-mail"
    .cc = ""
    .BCC = ""
    .Subject = "Solicitação de pranchas"
    .Attachments.Add "C:\Users\fcvelho\Desktop\Paraná\Print\fcvelho.png"

 

   
    .HTMLBody = "Segue em anexo agendamento"
    .Send 'or use .Display

End With

Ficava como temporario e não enviava para os outrs a imagem... dae mudei e ficou show!

Muito obrigado, você me ajudou muito cara!

Answer 11

Que bom que resolveu seu problema.

Atenção: Eu utilizava a função Environ("temp") para salvar o arquivo anexado numa pasta temporária, e depois a apagava. Environ("Save") não significa nada, e você pode simplesmente remover do seu código.

---

Felipe Costa Gualberto - http://www.ambienteoffice.com.br

Answer 12

Certo, ja vou altera lá. Obrigado

Estou com um grande problema agora... finalizei todos os procedimentos, quando vou abrir a planilha, da um monte de erro, quando fecho o UserForm a planilha fica aberta :S, ta complicado rsrs to apanhando aqui.

Answer 13

Não estou conseguindo reproduzir seu problema.

Poderia ser mais específicos em relação aos erros?

---

Felipe Costa Gualberto - http://www.ambienteoffice.com.br

Answer 14

Boa tarde Bezadeus, tudo bem?

Consegui fazer mais algumas coisas no meu projeto, mas agora estou fazendos os testes e encontrei um grande problema...

Data, esta invertendo e consigo fazer filtro avançado por que não encontra as datas.

Answer 15

Olá, como creio que sua pergunta não está relacionada com a pergunta original, seria melhor criar um novo tópico com outra pergunta. Dessa forma, o fórum fica mais organizado e mais pessoas podem te ajudar. Mas tudo bem, na próxima vez você lembra disso.

Voltando à sua pergunta, para não inverter uma data, grave ela (por VBA) dessa forma numa célula, supondo que o valor que quer gravar esteja num formulário na caixa de texto TextBox1:

Cells(linha, coluna) = CLng(CDate(TextBox1))

---

Felipe Costa Gualberto - http://www.ambienteoffice.com.br