Print de tela do de...
 
Notifications
Clear all

Print de tela do deskop

3 Posts
2 Usuários
0 Likes
998 Visualizações
(@cmbruno)
Posts: 73
Estimable Member
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?

 
Postado : 05/03/2021 1:30 pm
(@teleguiado)
Posts: 142
Estimable Member
 

@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

 
Postado : 05/03/2021 2:14 pm
(@cmbruno)
Posts: 73
Estimable Member
Topic starter
 

@teleguiado

Obrigado, vou tentar adaptar ela. Valeu.

 
Postado : 05/03/2021 3:30 pm