Office VBA也能任性截图（屏幕任意区域截图）

Excel是否可以实现屏幕任意区域截图？听起来似乎有些不务正业，已经有那么多截图软件，并且微信、QQ等也都提供了截图功能，但是存在的就是合理的，借助强大的PowerShell就可以实现任意区域截图功能。

示例代码如下。

Sub ScreenShot(strFile, pos_x, pos_y, image_width, image_height)
    Dim strArgs As String
    Dim strPSCmd As String
    strArgs = Join(Array("'" & strFile & "'", pos_x, pos_y, image_width, image_height))
    strPSCmd = "function SSRegion($strFile, $pos_x, $pos_y, $image_width, $image_height) {" & _
            "Add-Type -AssemblyName System.Drawing;" & _
            "$bitmap = [System.Drawing.Bitmap]::new($image_width, $image_height);" & _
            "$graphics = [System.Drawing.Graphics]::FromImage($bitmap);" & _
            "$graphics.CopyFromScreen([System.Drawing.Point]::new($pos_x, $pos_y), [System.Drawing.Point]::new(0, 0), $bitmap.Size);" & _
            "$graphics.Dispose();" & _
            "$bitmap.Save($strFile);" & _
            "$bitmap.Dispose();}; SSRegion "
    Shell "powershell -Command " & strPSCmd & strArgs
End Sub

【代码解析】
第4行代码将参数组合为一个空格分隔的字符串。
第5~10行代码为PowerShell命令。
第11行代码调用Shell执行PowerShell命令。
第14行代码调用ScreenShot过程完成截屏，截屏区域区域左上角屏幕坐标为(100,100)，截图区域宽度和高度均为300像素。

运行Demo过程，悄无声息完成截图，是不是有点儿酷！

Sub Demo()
    ScreenShot "C:\Temp\SquareScrShot.png", 100, 100, 300, 300
End Sub

---

更新代码，截图保存为硬盘文件，并且拷贝到Windows系统剪贴板

Sub ScreenShot2(strFile, pos_x, pos_y, image_width, image_height)
    Dim strArgs As String
    Dim strPSCmd As String
    strArgs = Join(Array("'" & strFile & "'", pos_x, pos_y, image_width, image_height))
    strPSCmd = "function SSRegion($strFile, $pos_x, $pos_y, $image_width, $image_height) {" & _
            "Add-Type -AssemblyName System.Drawing; " & _
            "Add-Type -AssemblyName System.Windows.Forms; " & _
            "$bitmap = [System.Drawing.Bitmap]::new($image_width, $image_height); " & _
            "$graphics = [System.Drawing.Graphics]::FromImage($bitmap); " & _
            "$graphics.CopyFromScreen([System.Drawing.Point]::new($pos_x, $pos_y), [System.Drawing.Point]::new(0, 0), $bitmap.Size); " & _
            "[System.Windows.Forms.Clipboard]::SetImage($bitmap); " & _
            "$graphics.Dispose(); " & _
            "$bitmap.Save($strFile); " & _
            "$bitmap.Dispose();}; SSRegion "
    Shell "powershell -Command " & strPSCmd & strArgs
End Sub

代码仅为功能演示，并未考虑截图区域是否会超出屏幕分辨率等细节问题，大家可以自行完善。