UsedRange als Bild speichern
08.01.2019 09:36:56
Stefan
versuche seit einiger Zeit, einige Druckoptionen per VBA zur Verfügung zu stellen. Das Speichern von UsedRanges in den diversen Tabellenblättern funktioniert super.
Allerdings habe ich Probleme dabei, die gleichen Bereiche auch als jpg zu speichern. Bei der Suche bin ich auf diverse Codes gestoßen; einen davon habe ich angepasst; allerdings ist da irgendwo ein Fehler drin ... :/.
Hier der Code:
Option Explicit
Sub Druck_Bild()
Dim objPict As Object, objChrt As Chart
Dim rngImage As Range
Dim strFile As String
Application.ScreenUpdating = False
'On Error GoTo ErrExit
With ActiveSheet
Set rngImage = .UsedRange.Adress
rngImage.CopyPicture Appearance:=xlScreen, Format:=xlPicture
.PasteSpecial Format:="Bitmap", Link:=False, DisplayAsIcon:=False
strFile = ThisWorkbook.Path & "\Anlage"
Set objPict = .Shapes(.Shapes.Count)
objPict.Copy
Set objChrt = .ChartObjects.Add(1, 1, objPict.Width, objPict.Height).Chart
objChrt.Paste
objChrt.Export strFile
objChrt.Parent.Delete
objPict.Delete
End With
Set objPict = Nothing
Set objChrt = Nothing
Set rngImage = Nothing
Application.ScreenUpdating = True
End Sub
Kann mir hier bitte jemand helfen? Stehe auf dem Schlauch ...
