Bereich als jpg speichern Fehler
10.08.2016 12:16:59
Heino
Ich habe ein Problem mit einem Makro das ich hier im Formum gefunden habe.
Wenn ich das Makro ausführe erhalte ich ein leeres jpg.
Wenn ich aber einen Haltepunkt auf die Zeile objChrt.Paste setzt und das Markro durchlaufen lasse dann funktioniert es.( Also starten, wenn dann der Haltepunkt erreicht wird nochmals starten)
Allerdings nur wenn ich nicht sehr schnell wieder starte.
Hat jemand eine Idee woran das liegen kann ?
Habe schon mit anderen Beispielen versucht, ist aber auch dort so.
Gruß Heino
Option Explicit
Sub Range_To_Image()
Dim objPict As Object, objChrt As Chart
Dim rngImage As Range, strFile As String
On Error GoTo ErrExit
With ActiveSheet
Set rngImage = .Range("A1:D23")
rngImage.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
.PasteSpecial Format:="Bitmap", Link:=False, DisplayAsIcon:=False
Set objPict = .Shapes(.Shapes.Count)
strFile = "\\txkdbsler002\LER_info_screens\LER_welcome\" & ActiveSheet.Name & ".jpg"
objPict.Copy
Set objChrt = .ChartObjects.Add(1, 1, objPict.Width + 8, objPict.Height + 8).Chart
objChrt.Paste
objChrt.Export strFile
objChrt.Parent.Delete
objPict.Delete
End With
ErrExit:
Set objPict = Nothing
Set objChrt = Nothing
Set rngImage = Nothing
End Sub