Excel VBA保存截图

Posted 2023-05-07

【中文标题】Excel VBA保存截图

【英文标题】：Excel VBA save screenshot

【发布时间】：2015-12-03 09:29:39

【问题描述】：

我尝试使用 VBA 代码在 Excel 中截取工作表的屏幕截图，然后将其保存在指定路径中，但我无法正确保存它...

Sub My_Macro(Test, Path)
  Dim sSheetName As String
  Dim oRangeToCopy As Range
  Dim FirstCell As Range, LastCell As Range

  Worksheets(Test).Activate
  Set LastCell = Cells(Cells.Find(What:="*", SearchOrder:=xlRows, _
      SearchDirection:=xlPrevious, LookIn:=xlValues).Row, _
      Cells.Find(What:="*", SearchOrder:=xlByColumns, _
      SearchDirection:=xlPrevious, LookIn:=xlValues).Column)
  Set FirstCell = Cells(Cells.Find(What:="*", After:=LastCell, SearchOrder:=xlRows, _
      SearchDirection:=xlNext, LookIn:=xlValues).Row, _
      Cells.Find(What:="*", After:=LastCell, SearchOrder:=xlByColumns, _
      SearchDirection:=xlNext, LookIn:=xlValues).Column)

  sSheetName = Test ' worksheet to work on

  With Worksheets(sSheetName)
      .Range(FirstCell, LastCell).CopyPicture xlScreen, xlPicture
      .Export Filename:=Path + Test + ".jpg", Filtername:="JPG"
  End With

End Sub

Excel 不想在截屏后直接执行 .Export... 方法。 所以我尝试将图片粘贴到新图表中。 Excel 将图表图片保存在正确的位置，并在我的图片上添加图表...我也尝试将其粘贴到临时工作表中，但 Excel 不想将其导出...

任何想法

【问题讨论】：

我不认为 jpg 是 Excel 的有效导出格式（当您尝试手动导出 Excel 工作表时，请参阅列表）所以当您强制它这样做时，Excel 不知道该怎么做在代码中。

见这里：mrexcel.com/forum/excel-questions/…

【参考方案1】：

忙于 Luboš Suk 的想法。

只需更改图表的大小。请参阅下面的脚本。

Sub My_Macro(Test, Path)


 Test = "UNIT 31"
    Dim sSheetName As String
    Dim oRangeToCopy As Range
    Dim FirstCell As Range, LastCell As Range

    Worksheets(Test).Activate

    Set LastCell = Cells(Cells.Find(What:="*", SearchOrder:=xlRows, _
        SearchDirection:=xlPrevious, LookIn:=xlValues).Row, _
        Cells.Find(What:="*", SearchOrder:=xlByColumns, _
        SearchDirection:=xlPrevious, LookIn:=xlValues).Column)

    Set FirstCell = Cells(Cells.Find(What:="*", After:=LastCell, SearchOrder:=xlRows, _
        SearchDirection:=xlNext, LookIn:=xlValues).Row, _
        Cells.Find(What:="*", After:=LastCell, SearchOrder:=xlByColumns, _
        SearchDirection:=xlNext, LookIn:=xlValues).Column)

    sSheetName = Test ' worksheet to work on

    With Worksheets(sSheetName).Range(FirstCell, LastCell)

        .CopyPicture xlScreen, xlPicture
        'Getting the Range height
        PicHeight = .Height
        'Getting the Range Width
        PicWidth = .Width

        ''.Export Filename:=Path + Test + ".jpg", Filtername:="JPG"   'REMOVE THIS LINE


    End With


    With Worksheets(sSheetName)

        'Creating the Chart
        .ChartObjects.Add(30, 44, PicWidth, PicHeight).Name = "TempChart"

        With .ChartObjects("TempChart")

            'Pasting the Image
            .Chart.Paste
            'Exporting the Chart
            .Chart.Export Filename:=Path + Test + ".jpg", Filtername:="JPG"

        End With

        .ChartObjects("TempChart").Delete

    End With

End Sub

【讨论】：

谢谢大家，它可以正常工作并且完全符合我的要求。

【参考方案2】：

几个月前我也在做类似的事情。我需要制作特定范围的屏幕截图并将其导出到文件中。经过数小时的捣蛋后，我找到了.chart.export 的解决方案，这对我来说似乎最用户友好。请查看我的代码，我认为您可以根据需要轻松更新它。简单的想法是创建图表，粘贴你想要截图的任何内容，将图表导出到图片，然后删除 id。简单而优雅。有什么问题欢迎追问

Sub takeScreen()
    Dim mainSheet As Worksheet
    Set mainSheet = Sheets("Input-Output")

    Dim path As String
    path = Application.ActiveWorkbook.path

    Application.ScreenUpdating = False


    If Dir(path & "\figures\", vbDirectory) = "" Then
        MsgBox "Directory figures not found. Cannot save image."
        Exit Sub
    End If

    With mainSheet
        .ChartObjects.Add(30, 44, 765, 868).Name = "exportChart"
        With .ChartObjects("exportChart")
            .Chart.ChartArea.Border.LineStyle = xlNone
            .Chart.ChartArea.Fill.Visible = False
            mainSheet.Range(mainSheet.Cells(4, "B"), mainSheet.Cells(60, "L")).CopyPicture
            .Chart.Paste
            .Chart.Export fileName:=path & "\figures\" & "fatigue_summary.png ", FilterName:="png"
        End With
        .ChartObjects("exportChart").Delete
    End With

    Application.ScreenUpdating = True

End Sub

根据您的评论，我认为您可以根据行/列大小及其计数来计算图表大小。或者您可以使用单元格位置和大小属性调整图表大小。 (look for .cells().width, .cells().height,.cells().top, .cells().left)

【讨论】：

您好 Luboš Suk，谢谢您的回答。我也是这样做的。它可以工作，但问题是，当我在图表中粘贴一行数据时，我会在图表末尾得到一个很大的空白区域，保存的图片也是如此。不知道能不能把图表调整成截图大小....

现在不完全确定，但您知道行的大​​小和复制的行数。因此，您可以据此计算大小并更改图表大小

@LubošSuk 只需粘贴并检查图像的大小，然后将其删除。看看我的回答。也在考虑使用 Shell 应用程序并粘贴到油漆中，但它不起作用，这就是我花了这么长时间的原因

@Jean-PierreOosthuizen 好主意。代码可以在某些部分进行优化，但很好的解决方案:)（但恕我直言，我宁愿计算大小，不要创建另一个图像然后删除它。但我会花一些时间测试你的解决方案，我很好奇）跨度>

您可以尝试检查选择的像素大小，然后将图表设置为 suxh