Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender

Forumthread: Liniendiagramm anzeigen

Liniendiagramm anzeigen
gert
Hallo Excel-Freunde,
seit Umstellung von Excel2003 auf Excel2007 habe ich das Problem,
dass bei nachfolgendem Code die Grafik nicht mehr sichtbar ist.
Ich sehe nur die leere Image.
In der Tabelle ist die Grafik sauber sichtbar.
Wer kann mir helfen?
Viele Grüsse
gert
Sub LinienDiagramm()
Dim strDName As String
Dim strBereich As String
Dim strTemp As String
Dim strGrafik As String
Dim objBlatt As Object
Dim bolVorhanden As Boolean
Dim lngLZ As Long, lngZ As Long
bolVorhanden = False
For Each objBlatt In ActiveWorkbook.Sheets
If objBlatt.Name = "Berechnung Versorgungslücke" Then
bolVorhanden = True
Exit For
End If
Next
If bolVorhanden = False Then
MsgBox "Das Blatt 'Berechnung Versorgungslücke' existiert nicht, das Diagramm kann nicht  _
erstellt werden.", vbOKOnly + vbExclamation, "Blatt fehlt"
Exit Sub
End If
On Error GoTo FEHLER
Application.ScreenUpdating = False
Set objBlatt = Sheets("Berechnung Versorgungslücke")
objBlatt.Visible = xlSheetVisible
Workbooks.Add
objBlatt.Range("A50:D119").Copy
ActiveSheet.Range("A50").PasteSpecial Paste:=xlValues
Range("A50:C119").NumberFormat = "$#,##0_);[Red]($#,##0)"
Range("D50:D119").NumberFormat = "YYYY"
For lngZ = 51 To 119
If Cells(lngZ, 1).Text  "" Then
If IsNumeric(Cells(lngZ, 1)) Then
lngLZ = lngZ
Else
Exit For
End If
End If
Next
strBereich = "A50:D" & lngLZ
strTemp = ActiveSheet.Name
Range("D50:D" & lngLZ).Copy
Range("A50").Insert Shift:=xlToRight
Range("E50:E" & lngLZ).ClearContents
'--------------------------------------------- Diagramm ---------------------------------------- _
Charts.Add
ActiveChart.Location Where:=xlLocationAsObject, Name:=strTemp
ActiveChart.SetSourceData Source:=Range(strBereich), PlotBy:=xlColumns
With ActiveChart
.ChartType = xlLine
.HasTitle = True
.ChartTitle.Characters.Text = "Situation im Alter"
.Axes(xlCategory, xlPrimary).HasTitle = False
'.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Jahr"
.Axes(xlValue, xlPrimary).HasTitle = False
'.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Betrag"
'.ApplyDataLabels Type:=xlDataLabelsShowValue, LegendKey:=False
.ApplyDataLabels Type:=xlDataLabelsShowNone, LegendKey:=False
.HasDataTable = False
.ChartArea.Border.Weight = 2
.ChartArea.Border.LineStyle = -1
.ChartArea.Interior.ColorIndex = 15
.ChartArea.Interior.PatternColorIndex = 1
.ChartArea.Interior.Pattern = 1
.PlotArea.Border.ColorIndex = 16
.PlotArea.Border.Weight = xlThin
.PlotArea.Border.LineStyle = xlContinuous
'Hier den Pfad zur Datei anpassen:
'Pfad zur Grafik zusammenbasteln:
'Pfad dieser Mappe:
'strGrafik = ThisWorkbook.Path
'If Right(strGrafik, 1)  "\" Then strGrafik = strGrafik & "\"
'Grafik:
strGrafik = "c:\situation im alter.bmp"
If Dir(strGrafik)  "" Then
.PlotArea.Fill.UserPicture PictureFile:=strGrafik
Else
.PlotArea.Interior.ColorIndex = 19
.PlotArea.Interior.PatternColorIndex = 1
.PlotArea.Interior.Pattern = xlSolid
End If
.SeriesCollection(3).Border.ColorIndex = 3
.SeriesCollection(3).Border.Weight = xlThick
.SeriesCollection(3).Border.LineStyle = xlContinuous
.SeriesCollection(2).Border.ColorIndex = 50
.SeriesCollection(2).Border.Weight = xlThick
.SeriesCollection(2).Border.LineStyle = xlContinuous
.SeriesCollection(1).Border.ColorIndex = 5
.SeriesCollection(1).Border.Weight = xlThick
.SeriesCollection(1).Border.LineStyle = xlContinuous
.Axes(xlValue).TickLabels.Font.Name = "Arial"
.Axes(xlValue).TickLabels.Font.FontStyle = "Fett Kursiv"
.Axes(xlValue).TickLabels.Font.Size = 10
.Axes(xlValue).TickLabels.AutoScaleFont = False
.Axes(xlCategory).TickLabels.Font.Name = "Arial"
.Axes(xlCategory).TickLabels.Font.FontStyle = "Fett Kursiv"
.Axes(xlCategory).TickLabels.Font.Size = 10
.Axes(xlCategory).TickLabels.AutoScaleFont = False
.Axes(xlCategory).TickLabels.Alignment = xlCenter
.Axes(xlCategory).TickLabels.Offset = 100
.Axes(xlCategory).TickLabels.Orientation = 45
.Axes(xlCategory).TickLabels.NumberFormat = "yyyy"
.Legend.Font.Name = "Arial"
.Legend.Font.FontStyle = "Fett Kursiv"
.Legend.Font.Size = 14
ActiveChart.PlotArea.Select
With Selection.Border
.ColorIndex = 16
.Weight = xlThin
.LineStyle = xlContinuous
End With
Selection.Fill.PresetGradient Style:=msoGradientHorizontal, Variant:=1, _
PresetGradientType:=msoGradientDaybreak
Selection.Fill.Visible = True
ActiveChart.ChartArea.Select
With Selection.Border
.Weight = 1
.LineStyle = -1
End With
Sheets("Tabelle1").DrawingObjects("Diagramm 1").RoundedCorners = False
Sheets("Tabelle1").DrawingObjects("Diagramm 1").Shadow = False
Selection.Fill.PresetGradient Style:=msoGradientHorizontal, Variant:=1, _
PresetGradientType:=msoGradientDaybreak
Selection.Fill.Visible = True
ActiveChart.Legend.Select
With Selection.Border
.Weight = xlHairline
.LineStyle = xlNone
End With
Selection.Shadow = False
Selection.Fill.PresetGradient Style:=msoGradientHorizontal, Variant:=1, _
PresetGradientType:=msoGradientDaybreak
Selection.Fill.Visible = True
Selection.Position = xlBottom
.ChartTitle.Shadow = True
.ChartTitle.AutoScaleFont = False
.ChartTitle.Border.ColorIndex = 57
.ChartTitle.Border.Weight = xlThin
.ChartTitle.Border.LineStyle = xlContinuous
.ChartTitle.Fill.PresetGradient Style:=msoGradientHorizontal, Variant:=1, _
PresetGradientType:=msoGradientDaybreak
.ChartTitle.Fill.Visible = True
.ChartTitle.Fill.ForeColor.SchemeColor = 5
.ChartTitle.Fill.BackColor.SchemeColor = 11
.ChartTitle.Font.Name = "Arial"
.ChartTitle.Font.FontStyle = "Fett"
.ChartTitle.Font.Size = 14
.ChartTitle.Font.ColorIndex = xlAutomatic
.Parent.Width = Image23.Width
.Parent.Height = Image23.Height
strTemp = ThisWorkbook.Path & Application.PathSeparator & "diagramm.gif"
.Export Filename:=strTemp, FilterName:="GIF"
Image23.Picture = LoadPicture(strTemp)
End With
FEHLER:
ActiveWorkbook.Close False
Application.ScreenUpdating = True
Set objBlatt = Nothing
End Sub

Anzeige

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Liniendiagramm anzeigen
31.05.2011 22:20:29
fcs
Hallo Gert,
ich hab deine Prozedur mal mit einem Image-Objekt in einem Userform getestet.
Sie funktioniert bei mir unter Excel 2007. Das aus den Daten erstellte Diagramm wird im Image-Objekt dargestellt.
Aus irgendeinem Grund springt bei dir die Prozedur in die FEHLER-Zeile bevor das Bild ins Image-Objekt geladen wird.
Um den Grund herauszufinden muss du die Zeile
On Error Goto FEHLER vorübergend deaktivieren (zu einer Bemerkung machen).
Dann bricht das Makro in der Zeile ab in der der Fehler auftritt und man kann nach dem Grund suchen.
Außerdem solltest du die Fehler-Prozedur ein wenig erweitern, so das der Grund für den Fehler angezeigt wird.
FEHLER:
If Err.Number  0 Then
MsgBox "Fehler-Nr.: " & Err.Number & vbLf & Err.Description
End If

Gruß
Franz
Anzeige
;

Forumthreads zu verwandten Themen

Anzeige
Anzeige
Anzeige
Entdecke relevante Threads

Schau dir verwandte Threads basierend auf dem aktuellen Thema an

Alle relevanten Threads mit Inhaltsvorschau entdecken
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige