@cmbruno
Utilizo o código abaixo para tirar um print do navegador e salvar numa pasta, veja se consegue adaptar para o que precisa.
'Declare Windows API Functions
#If VBA7 Then
Private Declare PtrSafe Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal _
bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
#Else
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal _
bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
#End If
'Declare Virtual Key Codes
Private Const VK_SNAPSHOT = &H2C
Private Const VK_KEYUP = &H2
Private Const VK_MENU = &H12
Public Const VK_TAB = &H9
Public Const VK_ENTER = &HD
Sub ScreenPrint()
Dim tmpSheet As Worksheet
Dim tmpChart As Chart
Dim tmpImg As Object
Dim PicWidth As Long, PicHeight As Long
'Serão pressionadas as teclas Alt + Print Screeen com uma API Windows
keybd_event VK_SNAPSHOT, 1, 0, 0 'apertar as teclas
keybd_event VK_SNAPSHOT, 1, VK_KEYUP, 0 'evento similar ao colar na área de transferência
' Set tmpSheet = Worksheets.Add
'Cola a imagem capturada do navegador e salva na pasta selecionada no código
Charts.Add
Application.Wait Now + TimeValue("00:00:01")
ThisWorkbook.Charts(1).AutoScaling = True
ThisWorkbook.Charts(1).Paste
ThisWorkbook.Charts(1).Export Filename:=ActiveWorkbook.Path & "\mapa" & id & "-" & x & ".jpg", FilterName:="jpg"
' & "\mapa" & id & "-" & x & ".jpg")
'Oculta mensagem de alerta ao excluir a imagem
Application.DisplayAlerts = False
ThisWorkbook.Charts(1).Delete
Application.DisplayAlerts = True
'**** se quiser colocar a imagem na planilha basta tirar o comentário '
'Attach_File
'ThisWorkbook.Activate
'ThisWorkbook.Sheets(1).Select
SendKeys "{NUMLOCK}", True
End Sub
Sub Alt_Tab()
DoEvents
keybd_event VK_MENU, 1, 0, 0 'Alt key down
DoEvents
keybd_event VK_TAB, 0, 0, 0 'Tab key down
DoEvents
keybd_event VK_TAB, 1, VK_KEYUP, 0 'Tab key up
DoEvents
keybd_event VK_ENTER, 1, 0, 0 'Tab key down
DoEvents
keybd_event VK_ENTER, 1, VK_KEYUP, 0 'Tab key up
DoEvents
keybd_event VK_MENU, 1, VK_KEYUP, 0 'Alt key up
DoEvents
End Sub
Sub Attach_File()
ActiveCell.Select
ActiveSheet.OLEObjects.Add(Filename:=ActiveWorkbook.Path & "\mapa" & id & "-" & x & ".jpg", Link:=False, DisplayAsIcon:=True, IconFileName:= _
"C:\Program Files\Internet Explorer\iexplore.exe", IconIndex:=10, IconLabel:="mapa.jpg").Select
End Sub
Obrigado.
Teleguiado.
E-mail: [email protected]
Postado : 05/03/2021 2:14 pm