Nach Bereich als Bild speichern, verzerrt
Stefan
mit folgendem Code kopiere ich einen Bereich und speichere ihn als Bilddatei ab. Allerdings ist das dann gespeicherte Bild extrem in die Breite gezogen. Hat jemand eine Idee, woran das liegt bzw. wie man es in normalen Größenverhältnissen speichern kann ?
Sub ScreenShot()
Dim wks As Worksheet
Dim cht As Chart
Dim iCounter As Integer
Dim sPath As String
ActiveSheet.PageSetup.PrintArea = ""
sPath = "Z:\Eigene Dateien\Excel\..." 'Hier individueller Pfad
Set wks = Worksheets("Direktauftrag")
ActiveSheet.PageSetup.PrintArea = "$A$1:$F$" & Cells(Rows.Count, "A").End(xlUp).Row
wks.Range(wks.PageSetup.PrintArea).CopyPicture _
Appearance:=xlScreen, _
Format:=xlPicture
Set cht = Charts.Add
cht.ChartArea.Clear
On Error Resume Next
cht.Paste
On Error GoTo 0
cht.Export sPath & wks.Name & ".gif"
Application.DisplayAlerts = False
cht.Delete
Application.DisplayAlerts = True
End Sub
Gruß
Stefan