Diagramm in VBA als Grafikdatei speichern?

[Dj-Gottschalk]

Hallo,

Wenn ich in Excel ein Diagramm erstelle möchte ich das dieses Diagramm als Bitmap abgespeichert wird. Was giebt es da so für möglichkeiten?

Danke

[alexf10]

dann kopiere die einfach in den clipboard und füge in mspaint ein.

so hast du dein bistmap

[Klotzkopp]

Die dazugehörige Methode des Chart-Objekts heißt CopyPicture.

[Dj-Gottschalk]

Ja danke erstmal.

Wie bekomme ich dieses Objetk dann ich eine Grafikdatei?

(mittels VBA?)

Hast jemand etwas code der das veranschaulicht?

Grüße

[Goos]

Du kannst das auch direkt ohne Zwischenablage machen.

...das schaut dann so in der Art aus:

Worksheets("Tabelle1").ChartObjects(1).Chart.Export Filename:="c:\chart.gif", FilterName:="GIF"

kannst natuerlich auch als FilterName BMP angeben, dazu muss aber der entsprechende Export Filter auf deinem System sein.

Nachzuschauen unter

HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Shared Tools\Graphics Filters\Export

Bye

Goos

[alexf10]

Sub DiagrammSpeichern()

Dim objDiagramm As ChartObject

Dim vntDateiname As Variant

Dim strFilter As String

Dim intButton As Integer

Dim blnSpeichern As Boolean

On Error Resume Next

With ActiveChart

vntDateiname = Application.GetSaveAsFilename(.Name, "TIFF-Dateien (*.tif), *.tif,JPEG-Dateien (*.jpg), *.jpg,GIF-Dateien (*.gif), *.gif", 1, APP_NAME)

If vntDateiname <> False Then

blnSpeichern = True

If Dir(vntDateiname) > "" Then

intButton = MsgBox(vntDateiname & " existiert bereits. Datei ersetzen?", vbYesNoCancel, APP_NAME)

If intButton <> vbYes Then

blnSpeichern = False

End If

End If

If blnSpeichern = True Then

strFilter = Right(vntDateiname, 3)

.Export vntDateiname, strFilter

If Err <> 0 Then

MsgBox "Fehler beim Schreiben der Datei.", vbCritical, APP_NAME

End If

End If

End If

End With

End Sub

oder so

Sub XLDiagrammErstellen()

'Erstellt ein Kreis- oder Säulendiagramm aus dem Inhalt

'der markierten Word-Tabelle und kopiert es in die Zwischenablage.

Dim objXL As Object

Dim intTyp As Integer

Dim intPlot As Integer

Const xl3DColumn = -4100

Const xl3DPie = -4102

Const xlRows = 1

Const xlColumns = 2

Const xlLocationAsNewSheet = 1

With Selection

If Not .Information(wdWithInTable) Then

MsgBox "Keine Tabelle markiert"

Exit Sub

Else

.Tables(1).Select

.Copy

End If

End With

With frmListenfeld

.Caption = "Diagramm erstellen"

With .lstListe

.Clear

.AddItem "3D-Kreisdiagramm"

.AddItem "3D-Säulendiagramm"

End With

.Show vbModal

If .lstListe.Value > "" Then

If .lstListe.Value = "3D-Kreisdiagramm" Then

intTyp = xl3DPie

intPlot = xlColumns

Else

intTyp = xl3DColumn

intPlot = xlRows

End If

Set objXL = CreateObject("Excel.Application")

If objXL Is Nothing Then

MsgBox "Excel kann nicht gestartet werden."

Exit Sub

End If

With objXL

.Workbooks.Add

.ActiveSheet.Paste

.Charts.Add

With .ActiveChart

.ChartType = intTyp

.SetSourceData Source:=objXL.Sheets("Tabelle1").UsedRange, PlotBy:=intPlot

.Location Where:=xlLocationAsNewSheet

.ChartArea.Copy

End With

.ActiveWorkbook.Close SaveChanges:=False

.Quit

End With

Set objXL = Nothing

MsgBox "Diagramm in Zwischenablage kopiert."

End If

End With

Unload frmListenfeld

End Sub

[Goos]

Hi alexf10,

du schreibst hier aber komisches zeugs

Dein DiagrammSpeichern schaut ja fast ok aus (ist ein recht komfortables chart.export), allerdings braucht man da kein "Dim objDiagramm As ChartObject", wenn man das dann nicht mehr verwendet und dieses "With ActiveChart" ist vielleicht auch etwas unguenstig, da man die Funktion ja meistens ueber ne Schaltfaelche aufruft und das Chart dann halt nicht mehr aktiv ist.

In deinem XLDiagrammErstellen() ........was machst du da?

Wozu sollte man dabei ne neue Instanz von Excel brauchen?

(halt ich fuer verschwenderisch )

Da reichts doch mal kurzzeitig ein neues Workbook, oder Worksheet einzufuegen (wobei das neue Chart da ja eh als Sheet eingefuegt wird).

Ausserdem versteh ich nicht, wieso man da die Ursprungsdaten zuerst ins neuerstellte Workbook kopieren sollte, wenn mans eh nicht speichert

Goos

[alexf10]

Wo warst du früher wenn du dich so gut auskennst? Das "komisches zeugs " funktioniert wunderbar. Ich habe nicht gesagt dass das Profilösung sein sollte. Mein Beispiel soll lediglich zwecks Gedankenanregung dienen. Falls du oder jemand anderer was besseres kennt - her mit dem Quelcode. Ansonsten keine sinnlose Diskussion weiterführen

mfg, alex

[alexf10]

noch ein beispeil (ist nicht von mir)

Private Sub cmdStart_Click()

Dim pctDiagramm As Object

Sheets("Diagramm1").Export "test.gif"

Application.DisplayAlerts = False

Sheets("Diagramm1").Delete

Application.DisplayAlerts = True

Worksheets.Add after:=Worksheets(Worksheets.Count)

Set pctDiagramm = ActiveSheet.Pictures.Insert("test.gif")

Kill "test.gif"

End Sub

[Goos]

Wie bitte?......wo war ich frueher?....wie meinst nun das? (im Kindergarten war ich ganz frueher mal :OD )

Ich hab doch auch nicht behauptet, dass dein "komisches Zeugs" nicht funktioniert.

Ich fand doch vor allem deinen ersten Lösungsvorschlag echt gut und hab nur noch ein paar Gedanken zur Verbesserung angebracht. Ach da faellt mir gerade noch ein... bei dem

MsgBox "Fehler beim Schreiben der Datei.", vbCritical, APP_NAME

ist APP_NAME glaub ich nicht definiert, infolgedessen hat die Message box keinen Titel denk ich. Man koennte vielleicht anstelle von APP_NAME ein "Excel" oder aehnliches hinschreiben.

Was ich hier aber gerade wirklich vermisse ist, dass sich vielleicht DJ-Gottschalk mal wieder meldet.......vielleicht interessiert der sich ja schon laengst nicht mehr dafuer

Goos

[alexf10]

ich habe damit dieses problem gemeint http://www.fachinformatiker-world.de/forums/showthread.php?s=&threadid=26370&werbeid=16

der beitrag stand fast eine woche lang ohne eine antwort. kaum antwortet einer wollen fast alle irgendwas dazusagen. nimm jetzt bitte nicht persönlich, ich will hier keinen angreifen, aber wenn du dich so gut auskennst warum hast du selber die lösung nicht komplett programiert ? :D es ist bloss eine andeutung, dass kritik ausüben viel leichter als enstecken

aber bin echt froh über kritik und verbesserungsvorschläge solange die was nutzen

gruß, alex

[Goos]

Ach das hast gemeint mit dem "wo warst du frueher"

Naja ich hatte die letzen Wochen Schule und da komm ich dann normalerweise nicht dazu hier grossartig reinzuschaun.

Wieso ich die Lösung nicht selbst komplett gemacht habe willst wissen?

Ansich ist das was ich oben schonmal geschrieben hab mit dem

Worksheets("Tabelle1").ChartObjects(1).Chart.Export Filename:="c:\chart.gif", FilterName:="GIF"

doch schon eine komplette Loesung....so ziemlich die kuerzeste die es gibt

Man muss dabei nur den Tabellennamen und den Filenamen entsprechend seinen Beduerfnissen anpassen.

Ich finde ausserdem, dass soviel als Tip zu einem Problem reicht.

Wenn es DJ-Gottschalk zu wenig gewesen waere, oder er es nicht kapiert haette, dann haette ich es auf Anfrage natuerlich etwas erklaert und vielleicht ausgeweitet.

Ich bin aber der Meinung, dass es dem betroffenen nicht allzuviel hilft, wenn man gleich den Code einer komfortablen Komplettloesung hinschreibt, da das dann erstens viel schwerer zu verstehen ist als nur der wirklich wichtige Teil und zweitens man nichts dabei lernt, wenn man einfach nur Codefragmente kopiert, aber nicht wirklich kapiert

Gruss Goos

[Dj-Gottschalk]

Hallo zusammen,

@goos

vielen Dank deine beiden zeilen waren für mein Problem bereits völlig aufreichend.

Also ich denke das Problem ist gelöst und ihr braucht nicht über sinn und Zweck von einfachen oder komfortablen lösungen streiten.

Grüße

Dj