Excel VBA save screenshot

Question

I try to take a screenshot of a Worksheet in Excel with VBA code and then to save it in a specified path, but I do not manage to save it properly...

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 doesn't want to execute the method .Export... directly after taking the screenshot. So I tried to paste the picture in a new chart. Excel save the chart picture at the right place with a chart on my picture... I also tried to paste it in a temporary worksheet but Excel doesn't want to export it...

Any idea

Answer 1

Was busy with the the idea Luboš Suk had.

Just change the size of the Chart. See script below.

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