如何执行Prnt Screen并将其保存到特定文件夹

Question

我找到了不使用 Sendkeys 方法执行 Prnt Screen 的代码：

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），但我想知道是否有办法打印屏幕并将其另存为.pdf/.jpg（没有matter) 到一个特定的文件夹。所有打印屏幕都是关于 Internet Explorer 页面的。

Answer 1

您的代码仅模拟 "pressing" PrtScrn 键，而不是 "releasing" 它。像这样在此处添加第二行：

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

Answer 2

我在另一个线程中找到了下面的代码，它正在按照您的要求工作。

我测试了它，它正在拍摄快照并将其保存到特定文件夹。

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 = "whosebug.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

参考：

How to take screenshot of webpage using VBA?

另外，您可以根据自己的需要修改代码。

如何执行Prnt Screen并将其保存到特定文件夹

How to perform Prnt Screen and save it into a specific folder

internet-explorer

automation

vba