30.05.2022, 08:55
Mahlzeit,
ich habe folgendes Diagram. Kann man das Makro nachträglich noch so ändern, dass das Diagramm vollflächig auf einer neuen Tabelle erstellt wird (wie bei taste F11) und alle nachfolgenden änderungen trotzdem gemacht werden ?
ich habe folgendes Diagram. Kann man das Makro nachträglich noch so ändern, dass das Diagramm vollflächig auf einer neuen Tabelle erstellt wird (wie bei taste F11) und alle nachfolgenden änderungen trotzdem gemacht werden ?
Code:
Sub ACDiagram03()
'
' diagram Makro
'
'
Sheets.Add After:=ActiveSheet
Range("M1").Select
ActiveCell.FormulaR1C1 = "grün"
Range("N1").Select
ActiveCell.FormulaR1C1 = "gelb"
Range("O1").Select
ActiveCell.FormulaR1C1 = "rot"
Range("O2").Select
Range("M2").Select
ActiveCell.FormulaR1C1 = "=IF(Tabelle1!RC[11]>5,Tabelle1!RC[11],NA())"
Range("M2").Select
Selection.AutoFill Destination:=Range("M2:M15"), Type:=xlFillDefault
Range("M2:M15").Select
Range("P4").Select
Range("N2").Select
ActiveCell.FormulaR1C1 = _
"=IF(AND(Tabelle1!RC[10]>3,Tabelle1!RC[10]<=5),Tabelle1!RC[10],NA())"
Range("N2").Select
Selection.AutoFill Destination:=Range("N2:N15"), Type:=xlFillDefault
Range("N2:N15").Select
Range("N18").Select
Range("Q4").Select
Range("O2").Select
ActiveCell.FormulaR1C1 = "=IF(Tabelle1!RC[9]<=3,Tabelle1!RC[9],NA())"
Range("O2").Select
Selection.AutoFill Destination:=Range("O2:O15"), Type:=xlFillDefault
Range("O2:O15").Select
Range("M1").Select
ActiveCell.FormulaR1C1 = "grün"
Range("M1:O15").Select
ActiveSheet.Shapes.AddChart2(297, xlColumnStacked).Select
ActiveChart.SetSourceData Source:=Range("Tabelle2!$M$1:$O$15")
ActiveSheet.Shapes("Diagramm 1").IncrementLeft -251.5
ActiveSheet.Shapes("Diagramm 1").IncrementTop -45
Range("H10").Select
ActiveSheet.ChartObjects("Diagramm 1").Activate
ActiveChart.FullSeriesCollection(3).Select
ActiveChart.FullSeriesCollection(3).Points(1).Select
ActiveChart.PlotArea.Select
ActiveChart.FullSeriesCollection(3).Select
With Selection.Format.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 0, 0)
.Transparency = 0
.Solid
End With
ActiveChart.FullSeriesCollection(1).Select
With Selection.Format.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 176, 80)
.Transparency = 0
.Solid
End With
ActiveChart.FullSeriesCollection(2).Select
With Selection.Format.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 255, 0)
.Transparency = 0
.Solid
End With
ActiveChart.Legend.Select
Selection.Delete
ActiveSheet.ChartObjects("Diagramm 1").Activate
ActiveChart.Axes(xlCategory).Select
ActiveChart.FullSeriesCollection(1).XValues = "=Tabelle1!$Z$2:$Z$13"
ActiveChart.ChartTitle.Select
ActiveChart.ChartTitle.Text = "Übersicht Sonderfreigaben"
Selection.Format.TextFrame2.TextRange.Characters.Text = "Übersicht Sonderfreigaben"
With Selection.Format.TextFrame2.TextRange.Characters(1, 15).ParagraphFormat
.TextDirection = msoTextDirectionLeftToRight
.Alignment = msoAlignCenter
End With
With Selection.Format.TextFrame2.TextRange.Characters(1, 15).Font
.BaselineOffset = 0
.Bold = msoFalse
.NameComplexScript = "+mn-cs"
.NameFarEast = "+mn-ea"
.Fill.Visible = msoTrue
.Fill.ForeColor.RGB = RGB(89, 89, 89)
.Fill.Transparency = 0
.Fill.Solid
.Size = 14
.Italic = msoFalse
.Kerning = 12
.Name = "+mn-lt"
.UnderlineStyle = msoNoUnderline
.Spacing = 0
.Strike = msoNoStrike
End With
ActiveChart.ChartArea.Select
ActiveWindow.LargeScroll ToRight:=-1
ActiveSheet.Shapes("Diagramm 1").ScaleWidth 1.3909722222, msoFalse, _
msoScaleFromTopLeft
ActiveSheet.Shapes("Diagramm 1").ScaleHeight 1.3356481481, msoFalse, _
msoScaleFromTopLeft
Range("K18").Select
ActiveSheet.ChartObjects("Diagramm 1").Activate
ActiveChart.SetElement (msoElementDataTableWithLegendKeys)
Range("M1").Select
ActiveCell.FormulaR1C1 = "Mah-1"
Range("N1").Select
ActiveCell.FormulaR1C1 = "Mah-2"
Range("O1").Select
ActiveCell.FormulaR1C1 = "Mah-3"
Range("O2").Select
End Sub