Excel VBA salvare screenshot

Question

cerco di prendere uno screenshot di un foglio di lavoro in Excel con codice VBA e poi salvarlo in un percorso specificato, ma non riesco a salvare in modo corretto ...

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 non vuole eseguire il metodo. Esporta ... direttamente dopo aver preso lo screenshot. Così ho provato a incollare l'immagine in un nuovo grafico. Excel salvare il disegno grafico al posto giusto con un grafico sulla mia immagine ... ho anche cercato di incollarlo in un foglio di lavoro di Excel temporaneo, ma non vuole esportare ...

Qualsiasi idea

Answer 1

Era occupato con l'idea che Luboš Suk aveva.

Basta modificare la dimensione del grafico. Vedi lo script qui sotto.

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 

Answer 2

Stavo facendo qualcosa di simile mesi fa. Avevo bisogno di creare uno screenshot di un particolare intervallo ed esportarlo in un file. Dopo ore di headsmashing in tabella ho trovato una soluzione con .chart.export che mi sembra più facile da usare. Si prega di dare un'occhiata al mio codice, penso che si può facilmente aggiornarlo alle vostre necessità. Il semplice pensiero è quello di creare un grafico, incollare tutto ciò che vuoi per catturare uno screenshot di esso, esportare un grafico su un'immagine e quindi eliminare l'id. Semplice ed elegante. Sentitevi liberi di chiedere se c'è qualche problema

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 

Secondo il vostro commento, penso che è possibile calcolare le dimensioni del grafico da riga/colonna e formato il loro conteggio. Oppure puoi ridimensionare il grafico usando gli attributi di posizione e dimensione delle celle. (look for .cells().width, .cells().height,.cells().top, .cells().left)