AW: Diagramm per VBA erstellen
18.12.2021 10:27:18
Beverly
Hi Frank,
sorry, hatte ich nicht mehr dran gedacht - aber ich antworte in vielen Threads und kann mir nicht den Inhalt aller Beiträge merken. ;-)
Private Sub Chart_Activate()
Dim LR As Long
Dim lngAnzahl As Long
Dim lngLauf As Long
Dim lngZeile As Long
Dim blnAlle As Boolean
lngAnzahl = Worksheets("Einstellungen").Range("B11")
With Sheets(TB)
LR = .Cells(.Rows.Count, "A").End(xlUp).Row 'letzte Zeile der Spalte A
LC = .Cells(1, .Columns.Count).End(xlToLeft).Column 'letzte Spalte der Zeile 1
If .AutoFilterMode Then .AutoFilterMode = False ' Autofilter ausschalten
.Cells(2, LC + 2).Resize(LR - 1, 1).FormulaR1C1 = "=IF(AND(RC6="""",RC7=""""),""X"","""")"
.Cells(1, LC + 2) = "#TMP#"
.Columns(LC + 2).AutoFilter Field:=1, Criteria1:="=" 'Nur Leere anzeigen
If lngAnzahl > .AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count + 1 Then
lngZeile = 2
blnAlle = True
Else
For lngZeile = LR To 2 Step -1
If .Rows(lngZeile).RowHeight > 0 Then lngLauf = lngLauf + 1
If lngLauf = lngAnzahl Then Exit For
Next lngZeile
End If
Me.PlotVisibleOnly = True ' Ausgeblendete Zeilen weglassen
If Me.FullSeriesCollection.Count = 0 Then
Me.SeriesCollection.NewSeries
Me.SeriesCollection.NewSeries
End If
Me.FullSeriesCollection(1).Values = Worksheets(TB).Range("$F$" & lngZeile & ":$F$" & LR) '.SpecialCells(xlCellTypeVisible)
Me.FullSeriesCollection(1).XValues = Worksheets(TB).Range("$A$" & lngZeile & ":$A$" & LR) '.SpecialCells(xlCellTypeVisible)
Me.FullSeriesCollection(2).Values = Worksheets(TB).Range("$G$" & lngZeile & ":$G$" & LR) '.SpecialCells(xlCellTypeVisible)
End With
With Me
'Ansichtseinstellungen vom Diagramm wiederherstellen
With .FullSeriesCollection(1)
.ApplyDataLabels
With .DataLabels
.Position = xlLabelPositionInsideBase
With .Format
With .Fill
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorAccent2
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = 0.6000000238
.Transparency = 0
.Solid
End With
With .TextFrame2.TextRange.Font
.BaselineOffset = 0
.Fill.Visible = msoTrue
.Fill.ForeColor.RGB = RGB(0, 0, 0)
.Fill.Transparency = 0
.Fill.Solid
.Size = 10
End With
With .Line
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 176, 80)
.Transparency = 0
.Weight = 1.5
End With
End With
End With
End With
With .FullSeriesCollection(2)
.ApplyDataLabels
With .DataLabels
.Position = xlLabelPositionInsideBase
With .Format
With .Fill
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorAccent2
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = 0.6000000238
.Transparency = 0
.Solid
End With
With .TextFrame2.TextRange.Font
.BaselineOffset = 0
.Fill.Visible = msoTrue
.Fill.ForeColor.RGB = RGB(0, 0, 0)
.Fill.Transparency = 0
.Fill.Solid
.Size = 10
End With
With .Line
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 0, 80)
.Transparency = 0
.Weight = 1.5
End With
End With
End With
End With
End With
Me.Refresh
If blnAlle Then MsgBox "Die Anzahl der Datensätze ist größer" & vbLf & _
"als die Anzahl der gefilterten Daten." & vbLf & _
"Es werden alle gefilterten Daten angezeigt."
End Sub
Bis später
Karin