Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1216to1220
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
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

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

319 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige