使用Excel VBA宏捕获+保存相同文件中特定区域的屏幕截图 [英] Using Excel VBA Macro To Capture + Save Screenshot of Specific Area In Same File

问题描述

我正在尝试创建一个宏，它使用ActiveX控件按钮（点击）来截取我的桌面屏幕，并将其保存在与按钮相同的Excel表格中。如何创建一个大小为800x600的屏幕截图（不是完整的桌面视图），然后将其粘贴到与该按钮相同的表单的左侧？我尝试过这么多方式，包括sendkeys（最简单的）。

我将捕获过程保存在模块中：

  Sub PasteScreenShot （）
 Application.SendKeys（{1068}）
 ActiveSheet.Paste 
 End Sub 
  

然后在ActiveX按钮代码中调用子。捕获工作，但我无法找出一种方法来操纵其区域抓取或其在工作表上的粘贴位置。

我正在尝试使用按钮进行自动化，而不是使用剪贴工具。

解决方案

这告诉我，在下一行代码执行之前， SendKeys 的处理速度不足以将数据放入剪贴板中，以解决问题有两种可能的解决方案。

1. 您可以尝试 Application.Wait 。这个方法似乎在我测试的时候工作，但是我会提醒你，这也是不可靠的。


2. 一个更好的选择是
   DoEvents ，
   因为它是明确的旨在处理这种事情：

DoEvents 将控件传递给操作系统。在操作系统完成处理其队列中的事件并发送 SendKeys 队列中的所有密钥之后，将返回控制。

这对我来说无论我是从IDE手动运行宏，从Macros功能区还是从按钮单击事件过程：

  Option Explicit 
 Sub CopyScreen（）
 
 Application.SendKeys（{1068}），True 
 DoEvents 
 ActiveSheet.Paste 
 
 Dim shp As Shape 
 With ActiveSheet 
设置shp = .Shapes（.Shapes.Count）
结束
 
 End Sub 
  

如何定位，调整大小和裁剪图像：

无论使用哪种方法，一旦使用 ActiveSheet.Paste 粘贴图片将会是一个可以操作的Shape。

要调整大小：，一旦你有一个形状的句柄，只需分配它的高度和宽度属性根据需要：

  Dim shp As Shape 
 With ActiveSheet 
设置shp = .Shapes（.Shapes.Count）
结束
 shp.Height = 600 
 shp.Width = 800 
  

要定位：使用形状的 TopLeftCell 属性。

To Crop It：使用 shp.PictureFormat.Crop （和/或 CropLeft ， CropTop ， CropBottom ， CropRight 如果您需要微调屏幕截图的哪一部分需要。例如，将贴图截图缩小到800x600：

  Dim h As Single，w As Single 
h =  - （ 600  -  shp.Height）
w =  - （800  -  shp.Width）
 
 shp.LockAspectRatio = False 
 shp.PictureFormat.CropRight = w 
 shp.PictureFormat .CropBottom = h 
  

I'm trying to create a macro which uses an ActiveX control button (click) to take a screenshot of my desktop screen and save it within the same excel sheet as the button. How can I create a screenshot 800x600 in size (not full desktop view) and then have it pasted into the left hand side of the same sheet as the button? I have tried this numerous ways including sendkeys (simplest).

I saved the capture process in a module:

Sub PasteScreenShot()
Application.SendKeys "({1068})"
ActiveSheet.Paste
End Sub

And then call the sub in the ActiveX button code. The capture works but I cannot figure out a way to manipulate its area grab or its pasted location on the sheet.

I am trying to automate with buttons rather than using the snipping tool.

解决方案

Without using 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
    ActiveSheet.Paste
End Sub

However, with this approach if you are using multiple monitors, it will only capture the active monitor, so further effort needs to be made if you need to capture the other monitor (this can probably be done with API calls but I haven't gotten that far).

NB: The AppActivate statement can be used to activate another (non-Excel) application and if you do this, then the keybd_event function will only capture that application, e.g;

AppActivate "Windows Command Processor" 'Modify as needed
keybd_event VK_SNAPSHOT, 1, 0, 0
ActiveSheet.Paste

Using SendKeys, Problem Solved:

While SendKeys is notoriously flaky, if you need to use this method due to limiations of the API method described above, you might have some problems. As we both observed, the call to ActiveSheet.Paste was not actually pasting the Print Screen, but rather it was pasting whatever was previously in the Clipboard queue, to the effect that you needed to click your button to call the macro twice, before it would actually paste the screenshot.

I tried a few different things to no avail, but overlooked the obvious: While debugging, if I put a breakpoint on ActiveSheet.Paste, I was no longer seeing the problem described above!

This tells me that the SendKeys is not processed fast enough to put the data in the Clipboard before the next line of code executes, to solve that problem there are two possible solutions.

1. You could try Application.Wait. This method seems to work when I test it, but I'd caution that it's also unreliable.
2. A better option would be DoEvents, because it's explicitly designed to handle this sort of thing:

DoEvents passes control to the operating system. Control is returned after the operating system has finished processing the events in its queue and all keys in the SendKeys queue have been sent.

This works for me whether I run the macro manually from the IDE, from the Macros ribbon, or from a button Click event procedure:

Option Explicit
Sub CopyScreen()

Application.SendKeys "({1068})", True
DoEvents
ActiveSheet.Paste

Dim shp As Shape
With ActiveSheet
    Set shp = .Shapes(.Shapes.Count)
End With

End Sub

How To Position, Resize & Crop the Image:

Regardless of which method you use, once the picture has been pasted using ActiveSheet.Paste it will be a Shape which you can manipulate.

To Resize: once you have a handle on the shape, just assign its Height and Width properties as needed:

Dim shp As Shape
With ActiveSheet
    Set shp = .Shapes(.Shapes.Count)
End With
shp.Height = 600
shp.Width = 800

To Position It: use the shape's TopLeftCell property.

To Crop It: use the shp.PictureFormat.Crop (and/or CropLeft, CropTop, CropBottom, CropRight if you need to fine-tune what part of the screenshot is needed. For instance, this crops the pasted screenshot to 800x600:

Dim h As Single, w As Single
h = -(600 - shp.Height)
w = -(800 - shp.Width)

shp.LockAspectRatio = False
shp.PictureFormat.CropRight = w
shp.PictureFormat.CropBottom = h

这篇关于使用Excel VBA宏捕获+保存相同文件中特定区域的屏幕截图的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！