Question

我试图通过在后台单击带有VBA代码的按钮，直接从Excel工作表自动生成小尺寸屏幕截图。情况如下：

我必须截取cellrange G1：I12的屏幕截图，并将其保存在文件名中叫做scrt.png。屏幕截图的大小应与cellrange G1的大小完全相同：I12

从之前的一篇帖子中，我发现这个代码似乎首先包括所提到的范围的截图到新的ChartSheet，然后它成功地将scrt.png文件保存在上述位置。实质上，它成功地在ChartSheet中生成所选单元格范围的位图，并在所提到的位置生成单独的scrt.png文件。但是，代码的问题是创建的scrt.png文件具有整个ChartSheet屏幕截图。我正在寻找的只是使用上述单元格范围快照保存的文件。试图调整代码，但没有成功。任何帮助将不胜感激。

Sub Macro1()
    myFileName = "scrt.png"
    Range("G1:I12").Select
    Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture

    Charts.Add
    ActiveChart.Paste
    ActiveChart.Export Filename:=ThisWorkbook.Path & "\" & myFileName, Filtername:="PNG"
End Sub

非常感谢。

Answer 1

不使用图表工作表，而是在常规工作表上使用嵌入式图表对象 - 然后您可以在粘贴复制的范围图片之前调整其大小

Sub Tester()

    ExportRange Selection, "C:\_Stuff\test\scrt.png"

End Sub


Sub ExportRange(rng As Range, sPath As String)

    Dim cob, sc

    rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture

    Set cob = rng.Parent.ChartObjects.Add(10, 10, 200, 200)
    'remove any series which may have been auto-added...
    Set sc = cob.Chart.SeriesCollection
    Do While sc.Count > 0
        sc(1).Delete
    Loop

    With cob
        .Height = rng.Height
        .Width = rng.Width
        .Chart.Paste
        .Chart.Export Filename:=sPath, Filtername:="PNG"
        .Delete
    End With

End Sub

在Excel VBA中截取屏幕截图并保存在单独的文件中

1 个答案: