Notifications
Clear all

Print de tela do deskop


cmbruno
(@cmbruno)
Trusted Member Registered
Entrou: 7 anos atrás
Posts: 64
Topic starter  

Boa tarde,

Pessoal existe alguma macro pra rodar no Excel que vá e tire um print da tela do desktop ( não a tela do Excel ) e salve esse print como PNG? Alguém saberia dizer se é possivel?


ResponderCitar (Quote)
teleguiado
(@teleguiado)
Estimable Member Registered
Entrou: 5 anos atrás
Posts: 114
 

@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: telegui4do@gmail.com


ResponderCitar (Quote)
cmbruno
(@cmbruno)
Trusted Member Registered
Entrou: 7 anos atrás
Posts: 64
Topic starter  

@teleguiado

Obrigado, vou tentar adaptar ela. Valeu.


ResponderCitar (Quote)