Как выполнить Prnt Screen и сохранить его в определенную папку - PullRequest
Новая
       13

Как выполнить Prnt Screen и сохранить его в определенную папку

0 голосов
/ 01 октября 2019

Я нашел код для выполнения Prnt Screen без использования метода Sendkeys: 

Option Explicit

Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal _
  bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

Private Const VK_SNAPSHOT = &H2C

Sub PrintScreen()
    keybd_event VK_SNAPSHOT, 1, 0, 0
End Sub

Я еще не пробовал, если он работает должным образом (если нет, я буду использовать Sendkeys), но яинтересно, есть ли способ Prnt Screen и сохранить его как .pdf / .jpg (не имеет значения) в определенной папке. Весь экран печати посвящен страницам Internet Explorer.

Ответы [ 2 ]

1 голос
/ 02 октября 2019

Я нашел приведенный ниже код в другом потоке, который работает в соответствии с вашими требованиями.

Я протестировал его, он делает снимок и сохраняет его в определенной папке. 

Option Explicit
'requires references: "Microsoft HTML Object Library" & "Microsoft Internet Controls"

Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, _
    ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Declare Function ShowWindow Lib "user32" _
    (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long

Sub getSS()
  Const url = "stackoverflow.com" 'page to get screenshot of (http is added below)
  Const fName = "D:\thumb_" & url & ".png" 'output filename (can be png/jpg/bmp/gif)
  Const imgScale = 0.25 'scale to 25% (to create thumbnail)

  Dim ie As InternetExplorer, ws As Worksheet, sz As Long
  Dim img As Picture, oCht As ChartObject
  Set ws = ThisWorkbook.Sheets("Sheet1")
  Set ie = GetIE()
  With ie
    .navigate "http://" & url
    Do: DoEvents: Loop While .busy Or .readyState <> 4 'wait for page load
    ShowWindow Application.hwnd, 5 'activate IE window
    Call keybd_event(44, 0, 0, 0) '44="VK_SNAPSHOT"
    Pause (0.25) 'pause so clipboard catches up
    With ws
      ShowWindow Application.hwnd, 5 'back to Excel
      .Activate
      .Paste
      Set img = Selection
      With img
        Set oCht = ws.ChartObjects.Add(.Left, .Top, .Left + .Width, .Top + .Height)
        oCht.Width = .Width * imgScale 'scale obj to picture size
        oCht.Height = .Height * imgScale
        oCht.Activate
        ActiveChart.Paste
        ActiveChart.Export fName, Mid(fName, InStrRev(fName, ".") + 1)
        oCht.Delete
        .Delete
      End With
      .Activate
    End With
    .FullScreen = False
    .Quit
  End With
  If Dir(fName) = "" Then Stop 'Something went wrong (file not created)
  sz = FileLen(fName)
  If sz = 0 Then Stop 'Something went wrong! (invalid filename maybe?)
  Debug.Print "Created '" & fName & "' from '" & url & "' (" & sz & " bytes)": Beep
End Sub

Sub Pause(sec As Single)
  Dim t As Single: t = Timer
  Do: DoEvents: Loop Until Timer > t + sec
End Sub

Function GetIE() As Object
'requires references: "Microsoft HTML Object Library" & "Microsoft Internet Controls"
'return an object for the open Internet Explorer window, or create new one
  For Each GetIE In CreateObject("Shell.Application").Windows() 'Loop to find
    If (Not GetIE Is Nothing) And GetIE.Name = "Internet Explorer" Then Exit For 'Found!
  Next GetIE
  If GetIE Is Nothing Then Set GetIE=CreateObject("InternetExplorer.Application") 'Create
  GetIE.Visible = True 'Make IE visible
  GetIE.FullScreen = True
End Function

Ссылка:

Как сделать снимок экрана веб-страницы с помощью VBA?

Кроме того, вы можете изменить код в соответствии со своими требованиями.

1 голос
/ 01 октября 2019

Код, который у вас есть, имитирует только «нажатие» клавиши PrtScrn, но не «отпускание» ее. Добавьте вторую строку здесь следующим образом: 

Option Explicit

Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal _
  bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

Private Const VK_SNAPSHOT = &H2C
Private Const KEYEVENTF_KEYUP = 2

Sub PrintScreen()
    keybd_event VK_SNAPSHOT, 1, 0, 0 'Key Down
    keybd_event VK_SNAPSHOT, 1, KEYEVENTF_KEYUP , 0 'Key Up
End Sub

Затем можно вставить снимок экрана в рабочую таблицу и экспортировать его в формате PDF 

Sub SaveAsPDF()
    Const FILE_PATH as String = "C:\Temp\"
    PrintScreen 'Take a screenshot
    With Sheet1
        .Paste 'Paste it to Sheet1
        .ExportAsFixedFormat xlTypePDF, FILE_PATH & "Screenshot File.pdf" 'Export Sheet1 to PDF
    End With
End Sub
.
...