ich stehe vor folgendem Problem. Per VBA exportiere ich ein Diagramm um es anschließend wieder in einer Picture-Box einlesen zu können. Das Ganze funktioniert auch sofern das Diagramm im Windowsfenster dargestellt wird. Sobald man aber in der Tabelle scrollt oder das Fenster minimiert und das Diagramm somit nicht mehr dargestellt wird, bekomme ich den Fehler "ungültiges Bild". Die exportierte Datei hat dann ebenfalls eine Größe von 0 KB.
Weis jemand an was das liegen könnte? Kennt jemand das Problem?
Über Eure hilfe wäre ich sehr dankbar.
Grüße Michael
Anbei noch der zugehörige Code:
Sub diagram_layout()
Dim Diagramm As Chart
Dim Dateiname As String
With ThisWorkbook.Worksheets("Diagram_Layout")
'Löscht diagramme
If .ChartObjects.Count > 0 Then
.ChartObjects.Delete
End If
End With
If UserForm1.ComboBox40.ListCount 0 Then
Bereit = False
Warten = False
'erstellt neues diagramm
Set Diagramm = ThisWorkbook.Worksheets("Diagram_Layout").ChartObjects.Add(900, 10, 500, 300). _
Chart
'Entfernt Rahmen des Diagramms
ThisWorkbook.Worksheets("Diagram_Layout").ChartObjects(1).Border.LineStyle = 0
With Diagramm
.ChartType = xlXYScatter
.HasTitle = True
.ChartTitle.Caption = ThisWorkbook.Worksheets("Übersetzung").Range("C121")
'Diagrammüberschrift
With .ChartTitle.Characters.Font
.Size = 13
.Bold = False
End With
'___________________________________
'Diagramm Konstantpumpe
'___________________________________
.SeriesCollection.NewSeries
.SeriesCollection.NewSeries
'SeriesCollection(1)
.SeriesCollection(1).Name = ThisWorkbook.Worksheets("Übersetzung").Range("C109")
.SeriesCollection(1).ChartType = xlXYScatterLinesNoMarkers
'.SeriesCollection(1).MarkerStyle = 2
'.SeriesCollection(1).MarkerSize = 7
'Wertebereich
.SeriesCollection(1).XValues = ThisWorkbook.Worksheets("Diagram_Layout").Range("A2:A3")
.SeriesCollection(1).Values = ThisWorkbook.Worksheets("Diagram_Layout").Range("B2:B3")
'.ChartTitle.Text = ""
'Notwendig um sekundärachse einzublenden
.SeriesCollection(2).AxisGroup = 2
Select Case UserForm1.ComboBox40.ListIndex
Case "0"
.SeriesCollection.NewSeries
'SeriesCollection(3)
.SeriesCollection(3).Name = "Kennpunkte"
.SeriesCollection(3).ChartType = xlXYScatter
'.SeriesCollection(3).MarkerStyle = 2
'.SeriesCollection(3).MarkerSize = 7
'Wertebereich
.SeriesCollection(3).XValues = ThisWorkbook.Worksheets("Diagram_Layout").Range("J2: _
_
_
J2")
.SeriesCollection(3).Values = ThisWorkbook.Worksheets("Diagram_Layout").Range("K2: _
_
_
K2")
'Datenbeschriftung
.SeriesCollection(3).ApplyDataLabels
.SeriesCollection(3).Points(1).DataLabel.Text = ThisWorkbook.Worksheets("Ü _
bersetzung").Range("C105")
'Löscht Legendeneinträge
.HasLegend = False
.HasLegend = True
.Legend.LegendEntries(3).Delete
.Legend.LegendEntries(2).Delete
'___________________________________
'Diagramm einstufige Regelung
'___________________________________
Case "1"
.SeriesCollection.NewSeries
.SeriesCollection.NewSeries
.SeriesCollection.NewSeries
'SeriesCollection(3)
.SeriesCollection(3).Name = "Kennpunkte"
.SeriesCollection(3).ChartType = xlXYScatter
'.SeriesCollection(3).MarkerStyle = 2
'.SeriesCollection(3).MarkerSize = 7
'Wertebereich
.SeriesCollection(3).XValues = ThisWorkbook.Worksheets("Diagram_Layout").Range("J6:J7")
.SeriesCollection(3).Values = ThisWorkbook.Worksheets("Diagram_Layout").Range("K6:K7")
'.ChartTitle.Text = ""
'Datenbeschriftung
.SeriesCollection(3).ApplyDataLabels
.SeriesCollection(3).Points(1).DataLabel.Text = ThisWorkbook.Worksheets("Ü _
bersetzung").Range("C106")
.SeriesCollection(3).Points(2).DataLabel.Text = ThisWorkbook.Worksheets("Ü _
bersetzung").Range("C105")
'SeriesCollection(4)
.SeriesCollection(4).Name = ThisWorkbook.Worksheets("Übersetzung").Range("C110")
.SeriesCollection(4).ChartType = xlXYScatterLinesNoMarkers
'.SeriesCollection(4).MarkerStyle = 2
'.SeriesCollection(4).MarkerSize = 7
'Wertebereich
.SeriesCollection(4).XValues = ThisWorkbook.Worksheets("Diagram_Layout").Range("A6:A8")
.SeriesCollection(4).Values = ThisWorkbook.Worksheets("Diagram_Layout").Range("B6:B8")
'SeriesCollection(5) 'Fläche unten
.SeriesCollection(5).Name = "Fläche unten"
.SeriesCollection(5).AxisGroup = 2
.SeriesCollection(5).ChartType = xlAreaStacked
With .SeriesCollection(5).Format.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(128, 100, 162)
.Transparency = 0.5
.Solid
End With
'Wertebereich
.SeriesCollection(5).XValues = ThisWorkbook.Worksheets("Diagram_Layout").Range("E5:E10") _
_
_
.SeriesCollection(5).Values = ThisWorkbook.Worksheets("Diagram_Layout").Range("F5:F10")
'Stellt sekundäre x Achse auf Datums
.Axes(xlCategory, xlSecondary).CategoryType = xlTimeScale
'Schaltet sekundäre x und y Achse aus
.HasAxis(xlCategory, xlSecondary) = False
.HasAxis(xlValue, xlSecondary) = True
'Löscht Legendeneinträge
.HasLegend = False
.HasLegend = True
.Legend.LegendEntries(5).Delete
.Legend.LegendEntries(3).Delete
.Legend.LegendEntries(1).Delete
'___________________________________
'Diagramm zweistufige Regelung
'___________________________________
Case "2"
.SeriesCollection.NewSeries
.SeriesCollection.NewSeries
.SeriesCollection.NewSeries
'SeriesCollection(4)
.SeriesCollection(4).Name = ThisWorkbook.Worksheets("Übersetzung").Range("C111")
.SeriesCollection(4).ChartType = xlXYScatterLinesNoMarkers
'Wertebereich
.SeriesCollection(4).XValues = ThisWorkbook.Worksheets("Diagram_Layout").Range("A13:A17" _
_
_
)
.SeriesCollection(4).Values = ThisWorkbook.Worksheets("Diagram_Layout").Range("B13:B17") _
_
_
With .SeriesCollection(4).Format.Line
.Visible = msoTrue
.ForeColor.RGB = RGB(238, 166, 22)
.Transparency = 0
End With
'SeriesCollection(3)
.SeriesCollection(3).Name = "Kennpunkte"
.SeriesCollection(3).ChartType = xlXYScatter
'.SeriesCollection(3).MarkerStyle = 2
'.SeriesCollection(3).MarkerSize = 7
'Wertebereich
.SeriesCollection(3).XValues = ThisWorkbook.Worksheets("Diagram_Layout").Range("J13:J15" _
_
_
)
.SeriesCollection(3).Values = ThisWorkbook.Worksheets("Diagram_Layout").Range("K13:K15") _
_
_
'Datenbeschriftung
.SeriesCollection(3).ApplyDataLabels
.SeriesCollection(3).Points(1).DataLabel.Text = ThisWorkbook.Worksheets("Übersetzung"). _
_
_
Range("C106")
.SeriesCollection(3).Points(2).DataLabel.Text = ThisWorkbook.Worksheets("Übersetzung"). _
_
_
Range("C107")
.SeriesCollection(3).Points(3).DataLabel.Text = ThisWorkbook.Worksheets("Übersetzung"). _
_
_
Range("C108")
'SeriesCollection(5) 'Fläche unten
.SeriesCollection(5).Name = "Fläche unten"
.SeriesCollection(5).AxisGroup = 2
.SeriesCollection(5).ChartType = xlAreaStacked
With .SeriesCollection(5).Format.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 192, 0)
.Transparency = 0.6
.Solid
End With
'Wertebereich
.SeriesCollection(5).XValues = ThisWorkbook.Worksheets("Diagram_Layout").Range("E12:E19" _
_
_
)
.SeriesCollection(5).Values = ThisWorkbook.Worksheets("Diagram_Layout").Range("F12:F19") _
_
_
'Stellt sekundäre x Achse auf Datums
.Axes(xlCategory, xlSecondary).CategoryType = xlTimeScale
'Schaltet sekundäre x und y Achse aus
.HasAxis(xlCategory, xlSecondary) = False
.HasAxis(xlValue, xlSecondary) = True
'Löscht Legendeneinträge
.HasLegend = False
.HasLegend = True
.Legend.LegendEntries(5).Delete
.Legend.LegendEntries(3).Delete
.Legend.LegendEntries(1).Delete
'___________________________________
'Diagramm Kennfeldregelung
'___________________________________
Case "3"
.SeriesCollection.NewSeries
.SeriesCollection.NewSeries
.SeriesCollection.NewSeries
.SeriesCollection.NewSeries
.SeriesCollection.NewSeries
'Achsen ein/ausschalten
.HasAxis(xlCategory, xlPrimary) = True
.HasAxis(xlValue, xlPrimary) = True
.HasAxis(xlCategory, xlSecondary) = True
'SeriesCollection(3) 'Kennpunkte
.SeriesCollection(3).Name = "Kennpunkte"
.SeriesCollection(3).ChartType = xlXYScatter
'.SeriesCollection(3).MarkerStyle = 2
'.SeriesCollection(3).MarkerSize = 7
'Wertebereich
.SeriesCollection(3).XValues = ThisWorkbook.Worksheets("Diagram_Layout").Range("J22:J26" _
_
_
)
.SeriesCollection(3).Values = ThisWorkbook.Worksheets("Diagram_Layout").Range("K22:K26") _
_
_
'Datenbeschriftung
.SeriesCollection(3).ApplyDataLabels
.SeriesCollection(3).Points(1).DataLabel.Text = ThisWorkbook.Worksheets("Übersetzung"). _
_
_
Range("C106")
.SeriesCollection(3).Points(2).DataLabel.Text = ThisWorkbook.Worksheets("Übersetzung"). _
_
_
Range("C107")
.SeriesCollection(3).Points(3).DataLabel.Text = ThisWorkbook.Worksheets("Übersetzung"). _
_
_
Range("C108")
.SeriesCollection(3).Points(4).DataLabel.Text = ThisWorkbook.Worksheets("Übersetzung"). _
_
_
Range("C107")
.SeriesCollection(3).Points(5).DataLabel.Text = ThisWorkbook.Worksheets("Übersetzung"). _
_
_
Range("C108")
'SeriesCollection(4) 'Teillastbereich
.SeriesCollection(4).Name = ThisWorkbook.Worksheets("Übersetzung").Range("C116")
.SeriesCollection(4).ChartType = xlXYScatterLinesNoMarkers
With .SeriesCollection(4).Format.Line
.Visible = msoTrue
.ForeColor.RGB = RGB(236, 112, 10)
.Transparency = 0
End With
'Wertebereich
.SeriesCollection(4).XValues = ThisWorkbook.Worksheets("Diagram_Layout").Range("A22:A25" _
_
_
)
.SeriesCollection(4).Values = ThisWorkbook.Worksheets("Diagram_Layout").Range("B22:B25") _
_
_
'SeriesCollection(5) 'Volllastbereich
.SeriesCollection(5).Name = ThisWorkbook.Worksheets("Übersetzung").Range("C117")
.SeriesCollection(5).ChartType = xlXYScatterLinesNoMarkers
With .SeriesCollection(5).Format.Line
.Visible = msoTrue
.ForeColor.RGB = RGB(192, 0, 0)
.Transparency = 0
End With
'Wertebereich
.SeriesCollection(5).XValues = ThisWorkbook.Worksheets("Diagram_Layout").Range("A22:A25" _
_
_
)
.SeriesCollection(5).Values = ThisWorkbook.Worksheets("Diagram_Layout").Range("C22:C25") _
_
_
'SeriesCollection(6) 'Fläche unten
.SeriesCollection(6).Name = "Fläche unten"
.SeriesCollection(6).AxisGroup = 2
.SeriesCollection(6).ChartType = xlAreaStacked
.SeriesCollection(6).Format.Fill.Visible = msoFalse
'Wertebereich
.SeriesCollection(6).XValues = ThisWorkbook.Worksheets("Diagram_Layout").Range("E21:E27" _
_
_
)
.SeriesCollection(6).Values = ThisWorkbook.Worksheets("Diagram_Layout").Range("F21:F27") _
_
_
'SeriesCollection(7) 'Kennfeld
.SeriesCollection(7).Name = ThisWorkbook.Worksheets("Übersetzung").Range("C118")
.SeriesCollection(7).AxisGroup = 2
.SeriesCollection(7).ChartType = xlAreaStacked
With .SeriesCollection(7).Format.Fill
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorAccent2
.Transparency = 0.3
.Solid
End With
'Wertebereich
.SeriesCollection(7).XValues = ThisWorkbook.Worksheets("Diagram_Layout").Range("E21:E27" _
_
_
)
.SeriesCollection(7).Values = ThisWorkbook.Worksheets("Diagram_Layout").Range("G21:G27") _
_
_
'Stellt sekundäre x Achse auf Datums
.Axes(xlCategory, xlSecondary).CategoryType = xlTimeScale
'Schaltet sekundäre x und y Achse aus
.HasAxis(xlCategory, xlSecondary) = False
.HasAxis(xlValue, xlSecondary) = True
'Löscht Legendeneinträge
.HasLegend = False
.HasLegend = True
.Legend.LegendEntries(7).Delete
.Legend.LegendEntries(4).Delete
.Legend.LegendEntries(2).Delete
End Select
'Passt größe des Diagramms auf größe des Image-Fensters an
.Parent.Width = UserForm1.Image1.Width
.Parent.Height = UserForm1.Image1.Height
'.PlotArea.Left = "15"
'.PlotArea.Top = "3"
'.PlotArea.Width = UserForm2.Image1.Width - 45
'.PlotArea.Height = UserForm2.Image1.Height - 50
'Richtet Achsenbeschriftungen aus
.SetElement (msoElementPrimaryCategoryAxisTitleAdjacentToAxis)
.SetElement (msoElementPrimaryValueAxisTitleRotated)
'schaltet x primärachse aus und y primärachse ein
.HasAxis(xlCategory, xlPrimary) = True
.HasAxis(xlValue, xlPrimary) = True
'Richtet Legende aus
.SetElement (msoElementLegendBottom)
'Eigenschaften der y-Achse
With Diagramm.Axes(xlValue, xlPrimary)
.MaximumScale = 6
.MinimumScale = 0
.MinorUnitIsAuto = True
.MajorUnitIsAuto = True
.HasTitle = True
.AxisTitle.Font.Bold = False 'deaktiviert Fette schrift
'Schaltet Achsenstriche und -beschriftung aus
.MajorTickMark = xlNone
.MinorTickMark = xlNone
.TickLabelPosition = xlNone
'Titel der y-Achse
.AxisTitle.Caption = ThisWorkbook.Worksheets("Übersetzung").Range("C113")
End With
'Eigenschaften der sekundären y-Achse
With Diagramm.Axes(xlValue, xlSecondary)
.MaximumScale = 6
.MinimumScale = 0
.MinorUnitIsAuto = True
.MajorUnitIsAuto = True
.HasTitle = True
.AxisTitle.Font.Bold = False
'Schaltet Achsenstriche und -beschriftung aus
.MajorTickMark = xlNone
.MinorTickMark = xlNone
.TickLabelPosition = xlNone
'Titel der y-Achse
.AxisTitle.Caption = ThisWorkbook.Worksheets("Übersetzung").Range("C120")
End With
'Eigenschaften der x-Achse
With Diagramm.Axes(xlCategory)
.MaximumScale = 7500
.MinimumScale = 0
.HasTitle = True
.AxisTitle.Font.Bold = False 'deaktiviert Fette schrift
.MinorUnitIsAuto = True
.MajorUnitIsAuto = True
'Titel der x-Achse
.AxisTitle.Caption = ThisWorkbook.Worksheets("Übersetzung").Range("C122")
'Schaltet Achsenstriche und -beschriftung aus
.MajorTickMark = xlNone
.MinorTickMark = xlNone
.TickLabelPosition = xlNone
End With
End With
Dateiname = Environ("temp") & "\diagramm_layout.gif"
Diagramm.Export Filename:=Dateiname, filtername:="GIF"
DoEvents
Application.ScreenUpdating = False
UserForm1.Image1.Picture = LoadPicture(Dateiname) 'Lädt Bild in _
_
_
Imagebox
Application.ScreenUpdating = True
Bereit = True
End If
End Sub