Wir wünschen allen Forenteilnehmern ein frohes Fest und einen guten Rutsch ins neue Jahr. x

macro diagram nachträglich ändern neue tabelle
#1
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 ?

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
Antworten Top
#2
Hallöchen,

1) Du kannst das Diagramm auch nach dem Erstellen als ein neues Blatt verschieben, im Prinzip (aufgzeichnet):

Zitat:Sub Makro1()
' Makro1 Makro
ActiveSheet.ChartObjects("Diagramm 1").Activate
ActiveChart.Location Where:=xlLocationAsNewSheet
End Sub

2) überarbeite mal Deinen sicher auch aufgezeichneten code. Zum einen findet man ab und zu mehrfache Select unmittelbar nacheinander, wozu soll das gut sein? Selektiert ist, wenn man auf einem Blatt bleibt, immer nur das zuletzt selektierte.

Zum anderen kann man meistens die zwei Zeilen mit ... .Select und Selection. ... oder ActiveCell. ... zu einer Codezeile zusammenfassen.
(Mal abgesehen von weiteren Möglichkeiten)
.      \\\|///      Hoffe, geholfen zu haben.
       ( ô ô )      Grüße, André aus G in T  
  ooO-(_)-Ooo    (Excel 97-2019+365)
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste