Hallo Ralf,
ist nicht so.
Weiße "Bilder" beim Grafikexport / Grafikexport funktioniert sporadisch nicht
Beim Export von Grafiken z.B. als gif oder jpg mit Hilfe von Diagrammflächen wird unter 2016 ein weißes Bild ausgegeben. Unmittelbare Ursache war, dass kein Bild in das Diagramm eingefügt wurde.
Unter 2010 lief der Code ohne diesen Fehler.
Im praktischen Betrieb erstelle ich aus einer Vielzahl an Excel-Dateien in einer Schleife Bilder. Dabei habe ich bemerkt, dass zu 100% das erste Bild der Schleife gefehlt hat.
Im Netz findet man u.a. zwei Vorschläge.
Bei einem wird empfohlen, vor der Bildkopie eine "normale" Kopie des Bereiches zu erstellen. Diese Vorschlag hat bei mir nichts gebracht.
Beim zweiten wird empfohlen, vor dem Einfügen das Blatt mit dem Diagramm zu selektieren. Ging bei mir auch nicht.
Ich habe den Export in einer gesonderten Funktion. In einem weiteren Versuch habe ich, da ja immer das erste Bild weiß war und die anderen korrekt, innerhalb der Funktion durch die Fehlerbehandlung einen zweiten Kopierversuch gestartet, angefangen mit der Zuweisung des Diagramms zur Objektvariablen. Auch das hat nichts gebraucht.
Erfolg hatte ich erst durch einen zweiten Aufruf der Funktion.
Hier mal ein extrahierter Beispielcode.
Hinweise:
Die Fehlerbehandlung müsste ggf. verschiedene Fehler auswerten. Ich möchte hier nur die Wiederholung demonstrieren.
Die Skalierung kann bei gleichem Seitenverhältnis der Bereiche und entsprechender Einstellung für die Seitenverhältnisse auf Height oder Widht eingekürzt werden.
Die Zeilennummern im Code sind übrigens ok und werden in der Fehlerbehandlung (Meldung) verwendet. Das erleichtert die Fehleranalyse bei On Error ...
Code:
Sub testgrexpo()
'Variablendeklaration
'Integer
Dim iA%
'Wenn Graphicexport einen Fehler bringt, dann
If GraphicsExport(ActiveSheet.Range("A1:D20"), "C:\temp\testgr2.gif", "gif", 1) = -1 Then
'... nochmal
GraphicsExport ActiveSheet.Range("A1:D20"), "C:\temp\testgr2.gif", "gif", 1
'Ende Wenn Graphicexport einen Fehler bringt, dann
End If
End Sub
'------------------------------------------------------------------------------
' [GraphicsExport] exportiert einen Bereich (RangeObjekt) als Grafik in die Datei
' <fname> dabei wird der Exportfilter <filter> benutzt und die Grafik scaliert
'------------------------------------------------------------------------------
Function GraphicsExport(r As Range, FName As String, Filter As String, ratio As Double) As Integer
'Variablendeklarationen: Objekt
Dim tempDia As ChartObject
'Bei Fehler Fehlerbehandlung
10 On Error GoTo errorhandler
20 GraphicsExport = 0
'Screenupdate ggf. auf wahr setzen, sonst ist der Bildbereich weiß
'50 Application.ScreenUpdating = True
'Diagramm setzten, genau ein leeres Diagramm muss vorhanden sein
60 Set tempDia = ThisWorkbook.Sheets("Tabelle1").ChartObjects(1)
'Bereich als Grafik kopieren
70 r.CopyPicture xlScreen, xlBitmap
'Mit dem Diagramm
80 With tempDia
'Diagramm auf Bildgroesse +1 scalieren, kein width wenn die Größenverhältnisse skaliert werden
90 .Height = r.Height + 1
100 .Width = r.Width + 1
'Kopie in Diagramm einfuegen
110 .Chart.Paste 'bei erstem Durchlauf wird hier in W10/2016 zuweilen nix eingefuegt
'Diagramm entsprechend ratio scalieren, kein width wenn die Größenverhältnisse skaliert werden
120 .Height = .Height * ratio
130 .Width = .Width * ratio
'Diagramm als Bild speichern
140 .Chart.Export FName, Filter, False
'Eingefuegtes Bild loeschen
150 .Chart.Shapes(1).Delete
'Ende Mit dem Diagramm
160 End With
errorhandler:
'Screenupdating ggf. auf False setzen
'170 Application.ScreenUpdating = False
'Objekt zuruecksetzen
180 Set tempDia = Nothing
' Maßnahme zur Reduktion von Speicher, enventuell durch ClearClipboard ersetzen
190 Application.CutCopyMode = False
'Wenn fehler, dann
210 If Err.Number <> 0 Then
'Fehlermeldung ausgeben
220 MsgBox "Fehler: " & Err.Number & " in GraphicsExport " & Err.Description & " Zeile: " & Erl
'Fehler loeschen
230 Err.Clear
GraphicsExport = -1
'Ende Wenn fehler, dann
240 End If
End Function
