Warning: file_get_contents(/data/phpspider/zhask/data//catemap/5/excel/27.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181

Warning: file_get_contents(/data/phpspider/zhask/data//catemap/3/heroku/2.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
Excel VBA保存屏幕截图_Vba_Excel - Fatal编程技术网

Excel VBA保存屏幕截图

Excel VBA保存屏幕截图,vba,excel,Vba,Excel,我试图用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:="*"

我试图用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不想执行该方法。导出。。。直接在截图之后。 所以我试着将图片粘贴到一个新的图表中。Excel将图表图片保存在正确的位置,并在我的图片上显示图表。。。我还尝试将其粘贴到临时工作表中,但Excel不想将其导出


有什么想法吗?

几个月前我也在做类似的事情。我需要制作一个特定范围的屏幕截图并将其导出到文件中。几个小时后,我用
.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

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

正忙着卢波苏克的想法

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

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

我不认为jpg是Excel的有效导出格式(当您尝试手动导出Excel工作表时,请参见列表),因此Excel不知道在代码中强制执行时该怎么做。请参见:Hi LubošSuk,谢谢您的回答。我也是这样做的。这是可行的,但问题是,当我只是在图表中粘贴一行数据时,我在图表的末尾得到了一个大的空白,以及保存的图片。我不知道是否可以将图表调整到屏幕截图的大小……现在还不确定,但您知道行的大小和复制的行数。因此,您可以从中计算大小,并根据it@LubošSuk只需粘贴并检查图像的大小,然后将其删除。看看我的答案。我也在考虑使用一个Shell应用程序并粘贴到画图中,但它不起作用,这就是我为什么这么做的原因long@Jean-PierreOosthuizen是个好主意。代码可以在某些部分进行优化,但很好的解决方案:)(但我宁愿计算大小,也不创建另一个图像,然后将其删除。但我会抽出一些时间,对我的解决方案进行测试,我很好奇)您可以试着检查选择的像素大小,然后将图表设置为suxh,它工作正常,完全符合我的要求。