Office: schlechte Bildqualität beim Export

Helfe beim Thema schlechte Bildqualität beim Export in Microsoft Excel Hilfe um das Problem gemeinsam zu lösen; Hallo, ich nutze folgenden Code um Diagramme und Bereiche als Bild von Excel zu exportieren: Code: Sub SelectedRangeToImage() Dim tmpChart As Chart,... Dieses Thema im Forum "Microsoft Excel Hilfe" wurde erstellt von Econ, 3. April 2019.

Seite 1 von 2

ECON

Econ

schlechte Bildqualität beim Export

Hallo,

ich nutze folgenden Code um Diagramme und Bereiche als Bild von Excel zu exportieren:

Code:

Sub SelectedRangeToImage()
Dim tmpChart As Chart, n As Long, shCount As Long, sht As Worksheet, sh As Shape
Dim fileSaveName As Variant, pic As Variant

'Create temporary chart as canvas
'kopiert einen Bereich und fügt diesen als Bild wieder ein
' Set sht = Selection.Worksheet
' Set sht = Selection.Worksheet
Set sht = Worksheets("Ansätze")
Selection.Copy
Worksheets("Ansätze").Cells(100, 50).Select
sht.Pictures.Paste.Select
Set sh = sht.Shapes(sht.Shapes.Count)
Set tmpChart = Charts.Add
'Charteigenschaften
tmpChart.ChartArea.Clear
tmpChart.name = "PicChart" & (Rnd() * 10000)
Set tmpChart = tmpChart.Location(Where:=xlLocationAsObject, name:=sht.name)
tmpChart.ChartArea.Width = sh.Width
tmpChart.ChartArea.Height = sh.Height
tmpChart.Parent.Border.LineStyle = 0
'Paste range as image to chart
sh.Copy
tmpChart.ChartArea.Select
tmpChart.Paste
'Save chart image to file
'speichert den Bereich / Bild mit Namen unter ausgewähltem Pfad
fileSaveName = path & imagename & ".jpg"
tmpChart.Export Filename:=fileSaveName, FilterName:="jpg"

'Clean up
sht.Cells(1, 1).Activate
sht.ChartObjects(sht.ChartObjects.Count).Delete
sh.Delete
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Leider werden die Bilder in sehr schlehcter Qualität exportiert. Wie kann ich das Problem lösen?

:)

Econ, 3. April 2019

#1
Beverly Erfahrener User

Hi,

ich benutze dazu folgenden Code:

Code:

Sub BereichAlsBildExportieren()
Application.ScreenUpdating = False
Selection.CopyPicture Appearance:=xlPrinter, Format:=xlPicture
With ActiveSheet.ChartObjects.Add(0, 0, Selection.Width, Selection.Height).Chart
.Parent.ShapeRange.Line.Visible = msoFalse
If Val(Application.Version) = 16 Then .ChartArea.Select
.Paste
.Export Filename:="C:\Test\Bild.jpg", FilterName:="JPG"
.Parent.Delete
End With
Application.ScreenUpdating = True
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Beverly, 5. April 2019

#2
ECON

Econ

Leider funktioniert dies nicht mit Diagrammen.

Außerdem nimmt die Bildqualität - wenn überhaupt - nur minimal zu. Ich habe schon meine Erwartungen gesenkt, dass die Bildqualität nicht zu 100% der Darstellung in Excel entspricht. Die derzeitigen Lösungen sind aber weit davon entfernt.

Ich frage mal weiter: Gibt es weitere Vorschläge?

Econ, 5. April 2019

#3
Beverly Erfahrener User

schlechte Bildqualität beim Export

Was meinst du mit "funktioniert nicht mit Diagrammen" - du hast doch geschrieben, du willst einen Tabellenbausschnitt exportieren...? Diagramme musst du nicht erst als Bild kopieren, in ein Diagramm einfügen und dann exportieren - das geht ohne diesen Umweg.

Beverly, 6. April 2019

#4
ECON

Econ

Ich möchte Tabellenausschnitte und Diagramme als Bilddatei exportieren und diese als .png speichern.

Ich habe nun mal aus deinem Beispiel Selection.CopyPicture auskommentiert und die Prozedur auf ein Diagramm angewendet. Es entsteht leider ein weißer Export.

Das Problem der geringen Auflösung ist damit aber auch noch nicht behoben.

Econ, 6. April 2019

#5
FLOTTER FEGER

Flotter Feger

Hallo,

welche Excel-Version verwendest du ? 2016 vermutlich ... oder ?

Flotter Feger, 6. April 2019

#6
ECON

Econ

Meine Version ist die 2010er. Aber

Code:

Debug.Print Application.Version
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

ergibt die Zahl 14, falls du darauf anspielst...

Econ, 6. April 2019

#7
Beverly Erfahrener User

schlechte Bildqualität beim Export

In deinem Code exportierst du einen Tabellenausschnitt und kein Diagramm - der Tabellenausschnitt wird kopiert und in ein Diagramm eingefügt, welches exportiert wird...

Sollen Tabellenausschnitt und Diagramm zusammen als ein gemeinsames Bild exportiert werden oder getrennt? Da musst du schon mal etwas genauer werden, bzw. am besten eine Beispielmappe hochladen und daran genau erklären was du machen willst.

Außerdem: weshalb erst - wie in deinem Code - ein Chart (Diagrammblatt) erstellen und dieses dann verschieben und als Diagrammobjekt in ein Tabellenblatt einbetten? Da kann man doch gleich ein eingebettetes Diagrammobjekt erstellen - siehe meinen Code.

Beverly, 6. April 2019

#8
FLOTTER FEGER

Flotter Feger

Hallo,

die Bildqualität mal außen vor gelassen ... und egal was Karin schreibt, bevor ein CopyPicture-Aufruf erfolgt, muss ab 2010 Application.ScreenUpdating = True stehen ... sonst wird nur ein komplett weißes Bild gespeichert.
Und, wenn du ein PNG speichern willst, dann so ... zumindest klappt es dann bei mir.

.Export Filename:="C:\TestBild.png", FilterName:="PNG", Interactive:=True

Hab zwar den Dialog, der dann eigentlich aufgehen sollte, noch nie gesehen, aber es wird zumindest ein PNG gespeichert.

Sollte dir die Bildqualität nicht zusagen, dann geht es nur über GDI+ besser.

Flotter Feger, 6. April 2019

#9
OFFICEUSER

OfficeUser Neuer User

von Flotter Feger

bevor ein CopyPicture-Aufruf erfolgt, muss Application.ScreenUpdating = True stehen ... sonst wird nur ein komplett weißes Bild gespeichert.
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Wo hast du das denn her...?

Selektierter Tabellenbereich:

Tabelle1
B C D E
8
9
10 4
11 6
12 7
13 9 z
14 z z
15 t z z
16
Excel-Inn.de

Hajo-Excel.de
XHTML-Tabelle zur Darstellung in Foren, einschl. der neuen Funktionen ab Version 2007
Add-In-Version 25.15 einschl. 64 Bit

und exportiertes Bild (im Anhang).

Zuletzt von einem Moderator bearbeitet: 12. Januar 2021

OfficeUser, 6. April 2019

#10
Beverly Erfahrener User

von Econ

Ich habe nun mal aus deinem Beispiel Selection.CopyPicture auskommentiert und die Prozedur auf ein Diagramm angewendet. Es entsteht leider ein weißer Export.
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Das ist auch logisch, da du dann nur ein leeres Diagramm erstellst (und anschließend exportierst) - die Zeile ist doch an dem Code gerade das Essentielle, denn sie kopiert den selektierten Tabellenbereich als Bild, um ihn dann in das erstellte Diagramm einzufügen und danach dieses Diagramm zu exportieren.

Wenn du mit der Bildqualität nicht zufrieden bist, dann musst du es über API-Funktionen realisieren:

Code:

Option Explicit

Private Declare PtrSafe Function OleCreatePictureIndirect Lib "oleaut32.dll" ( _
ByRef PicDesc As PICT_DESC, _
ByRef RefIID As GUID, _
ByVal fPictureOwnsHandle As LongPtr, _
ByRef IPic As IPicture) As LongPtr
Private Declare PtrSafe Function CopyImage Lib "user32.dll" ( _
ByVal handle As LongPtr, _
ByVal un1 As Long, _
ByVal n1 As Long, _
ByVal n2 As Long, _
ByVal un2 As Long) As LongPtr
Private Declare PtrSafe Function IsClipboardFormatAvailable Lib "user32.dll" ( _
ByVal wFormat As Long) As Long
Private Declare PtrSafe Function OpenClipboard Lib "user32.dll" ( _
ByVal hwnd As LongPtr) As Long
Private Declare PtrSafe Function GetClipboardData Lib "user32.dll" ( _
ByVal wFormat As Long) As LongPtr
Private Declare PtrSafe Function DeleteObject Lib "gdi32.dll" ( _
ByVal hObject As LongPtr) As Long
Private Declare PtrSafe Function CLSIDFromString Lib "ole32.dll" ( _
ByVal lpsz As Any, _
ByRef pCLSID As GUID) As Long
Private Declare PtrSafe Function EmptyClipboard Lib "user32.dll" () As Long
Private Declare PtrSafe Function CloseClipboard Lib "user32.dll" () As Long

Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type

Private Type PICT_DESC
Size As Long
Type As Long
hPic As LongPtr
hPal As LongPtr
End Type

Private Const PICTYPE_BITMAP As Long = 1
Private Const CF_BITMAP As Long = 2
Private Const IMAGE_BITMAP As Long = 0
Private Const LR_COPYRETURNORG As Long = &H4
Private Const GUID_IPICTUREDISP As String = "{7BF80981-BF32-101A-8BBB-00AA00300CAB}"

Private Function PastePicture(ByRef prlngptrCopy As LongPtr) As IPictureDisp

Dim lngReturn As Long, lngptrPointer As LongPtr

If CBool(IsClipboardFormatAvailable(CF_BITMAP)) Then

lngReturn = OpenClipboard(CLngPtr(Application.hwnd))

If lngReturn > 0 Then

lngptrPointer = GetClipboardData(CF_BITMAP)

prlngptrCopy = CopyImage(lngptrPointer, _
IMAGE_BITMAP, 0&, 0&, LR_COPYRETURNORG)

Call CloseClipboard

If lngptrPointer 0 Then Set PastePicture = _
CreatePicture(prlngptrCopy, 0)

End If
End If
End Function

Private Function CreatePicture( _
ByVal lngptrhPic As LongPtr, _
ByVal lngptrhPal As LongPtr) As IPictureDisp

Dim udtPicInfo As PICT_DESC, udtID_IDispatch As GUID
Dim objPicture As IPictureDisp

Call CLSIDFromString(StrPtr( _
GUID_IPICTUREDISP), udtID_IDispatch)

With udtPicInfo
.Size = Len(udtPicInfo)
.Type = PICTYPE_BITMAP
.hPic = lngptrhPic
.hPal = lngptrhPal
End With

Call OleCreatePictureIndirect(udtPicInfo, _
udtID_IDispatch, 0&, objPicture)

Set CreatePicture = objPicture

Set objPicture = Nothing

End Function

'************************************
' dieses Makro benutzen zum Starten des Exports
' exportiert wird der selektierte Tabellenblereich
'************************************
Sub ExportPicture()
Dim lngptrCopy As LongPtr
Dim objPicture As IPictureDisp

Call OpenClipboard(0&)
Call EmptyClipboard
Call CloseClipboard

Selection.CopyPicture _
Appearance:=xlScreen, Format:=xlBitmap

Set objPicture = PastePicture(lngptrCopy)

If objPicture Is Nothing Then
MsgBox "Picture can't store on Drive", vbCritical, "Error"
Else
Call SavePicture(Picture:=objPicture, Filename:="E:Z_TestBild1.png") 'hisWorkbook.Path & "Temp.bmp")
End If
Call DeleteObject(lngptrCopy)
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Zuletzt von einem Moderator bearbeitet: 12. Januar 2021

Beverly, 6. April 2019

#11
ECON

Econ

von Beverly

Wenn du mit der Bildqualität nicht zufrieden bist, dann musst du es über API-Funktionen realisieren:
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Super, die Qualität ist deutlich besser!

Da ich mich sehr für VBA-Programmierung interessiere und diese Funktionen nicht zum Standard gehören, würdest du mir ein paar Hinweise geben, wo man sich besser darüber informieren kann.

- Was ist das im Allgemeinen: Private Declare PtrSafe Function OleCreatePictureIndirect Lib "oleaut32.dll"
- Wo kann ich mich über den Typ .dll im Zusammenhang mit VBA informieren
- Wo finde ich Infomationen zu: Private Const GUID_IPICTUREDISP As String = "{7BF80981-BF32-101A-8BBB-00AA00300CAB}"
- ...

Also, es wäre wunderbar, wenn du mir da Literatur empfehlen kannst.

Zuletzt von einem Moderator bearbeitet: 12. Januar 2021

Econ, 6. April 2019

#12
Beverly Erfahrener User

schlechte Bildqualität beim Export

Einfach mal zum Begriff "api vba tutorial" im Internet suchen.

Beverly, 6. April 2019

#13
ECON

Econ

Danke!

Hast du einen Vorschlag, wie der linke und obere Rahmen beim Exportieren erhalten bleibt?

Econ, 6. April 2019

#14
ECON

Econ

...

das zugehörige Beispiel.

Wäre auch schön, wenn der Bildupload funktionieren würde und ich nicht für jeden Versuch eine neue Antwort schreiben müsste. Also einfach so lange die Vielfach Posts ignorieren, bis es klappt.

Econ, 6. April 2019

#15

(Du musst angemeldet oder registriert sein, um eine Antwort erstellen zu können.)

Seite 1 von 2

Thema:

schlechte Bildqualität beim Export

Die Seite wird geladen...

schlechte Bildqualität beim Export - Similar Threads - schlechte Bildqualität Export
Schlechtesten 3 Anlagen Aktuell
in Microsoft Excel Hilfe
Schlechtesten 3 Anlagen Aktuell: Hallo Zusammen, stelle mir die Frage wie bekomme ich die schlechtesten 3 Anlagen aufgelistet zur aktuellen Stunde. In der Beispieldatei befinden sich auf dem Blatt SIV ,Anlagen aufgelistet,es...
For Schleife, schlechte Performance
in Microsoft Excel Hilfe
For Schleife, schlechte Performance: Hallo zusammen, ich habe eine Tabelle mit 22.000 Ids, welche ich in einer 55.000 Zeilen großen Bestandstabelle Suche und bei Treffer einen Wert in einer Nachbarspalte überprüfe. Je nach...
Schlechte Performance unter Win 7
in Microsoft Access Hilfe
Schlechte Performance unter Win 7: Gefunden in Access Secrets vom 13.10.2011: ... wenn Sie Access 2010 auf einem System mit Windows 7 (oder 2008) einsetzen und eine Abfrage ausführen, wird in der Taskleiste von Windows der Text...
Kamera funktioniert nur bei Microsoft Teams schlecht.
in Microsoft Teams Hilfe
Kamera funktioniert nur bei Microsoft Teams schlecht.: Meine Kamera die ich vor kurzem gekauft habe funktioniert bei programmen wie Zoom oder Discord problemlos, aber auf Teams ruckelt es so, dass man nichts mehr erkennt....
Schlechte Audio (mikro) qualität trotz SEHR gutem Mikrofon
in Microsoft Teams Hilfe
Schlechte Audio (mikro) qualität trotz SEHR gutem Mikrofon: Hallo ich besitze ein shuresm7b + Cloudlifer + audio interface (Focusrite Scarlett solo 3rd gen) also ein sehr gutes setup. Trotzdem ist meine Audio Qualität sehr sehhhr schlecht in MS TEAM (Auch...
Summe ohne schlechtesten Wert
in Microsoft Excel Hilfe
Summe ohne schlechtesten Wert: Hallo ich habe eine kleine Frage, und zwar wie ich am elegantesten eine Formel für folgendes Problem schreiben kann. Ich habe einen Datenbereich von mehreren Werten, daraus möchte ich die Summe...
Schlechte Qualität einer Visio Grafik in Word
in Microsoft Word Hilfe
Schlechte Qualität einer Visio Grafik in Word: Servus an alle, mein Problem lautet so: Ich habe ein Prozessdiagramm in Visio03 Pro erstellt und das dann in Word kopiert. So weit ist alles klar gegangen, auch von der Qualität her. Smile...

Anmelden oder registrieren

Suche

Diese Seite verwendet Cookies, um Inhalte zu personalisieren, diese deiner Erfahrung anzupassen und dich nach der Registrierung angemeldet zu halten.
Auf dieser Website werden Cookies für die Zugriffsanalyse und Anzeigenmessung verwendet.
Wenn du dich weiterhin auf dieser Seite aufhältst, akzeptierst du unseren Einsatz von Cookies.

Akzeptieren Weitere Informationen...

Information ausblenden