Office Excel 2016 Screenshot aus Range abspeichern
21.06.2017 12:50:34
Wanig
ich stehe nach dem Office Wechsel von 2010 auf 2016 vor einem Problem.
Ich hoffe Ihr könnt mir hierbei weiterhelfen?
Ich habe eine Exceltabelle wo ein Bereich z.B. Tabelle "123" Range (A1:d20) als Bild abgespeichert werden soll in ein lokalen Pfad.
Bisher unter 2010 lief dies einwandfrei nun unter 2016 nicht mehr.
'Screenshot abspeichern
Sheets("Partner").Select
Application.ScreenUpdating = True
Application.ScreenUpdating = False
ActiveSheet.Range("S3:AH27").CopyPicture Appearance:=xlScreen, Format:=xlPicture
With ActiveSheet.ChartObjects.Add(0, 0, Range("S3:AH27").Width, Range("S3:AH27").Height).Chart
.Paste
.Export "G:\" & "Diagramm.jpg"
.Parent.Delete
End With
Application.ScreenUpdating = True
______________________________________________________________________
Ich habe derweilen schon einen weiteren Anlauf genommen über einen anderen Codeschnipsel. Es wird ein Screenshot erstellt jedoch nur im Tabellenblatt abgespeichert.
Die Abspeicherung in den Lokalenpfad funktioniert einfach nicht.
Ich habe auch schon die Deklaration "objChrt As Chart" in "objChrt As ChartObjects" getestet.
Was mache ich nur Falsch, ich sehe die Zahlen vor lauter Bäumen nicht mehr. :-(
Sub Range_To_Image()
Dim objPict As Object, objChrt As Chart
Dim rngImage As Range, strFile As String
Sheets("Landkarte").Select
On Error GoTo ErrExit
With Sheets("Landkarte") 'Tabellenname - Anpassen!
Set rngImage = .Range("P5:BW38")
rngImage.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
.PasteSpecial Format:="Bitmap", Link:=False, DisplayAsIcon:=False
Set objPict = .Shapes(.Shapes.count)
'strFile = "C:\Tools\Status-Karte.gif" 'Pfad und Dateiname für das Bild
objPict.Copy
Set objChrt = .Charts.Add(0, 0, objPict.Width + 8, objPict.Height + 8).Chart
objChrt.Paste
'objChrt.Export strFile
objChrt.Export Filename:="C:\Tools\Status-Karte.jpg", FilterName:="jpg"
objChrt.Parent.Delete
objPict.Delete
objChrt.Delete
End With
ErrExit:
Set objPict = Nothing
Set objChrt = Nothing
Set rngImage = Nothing
End Sub