Hallo zusammen,
ich habe ein Makro, dass mir aus einer Tabelle automatisch ein Diagramm erzeugt. Ein weiteres Makro, soll nun dieses Diagramm formatieren (Farben, Diagrammtyp etc.). Jetzt habe ich allerdings das Problem, dass neu angelegte Diagramme fortlaufend nummeriert werden. Ich weiß jedoch nicht, wie ich dies in meinem zweiten Makro berücksichtigen kann, so dass es egal ist, welchen Namen das erzeugte Diagramm hat.
Hier mein Makro-Code, der nicht funktioniert, weil er sich auf einen festen Diagramm-Namen bezieht:
ActiveSheet.Shapes(„Chart 29“).Select
Selection.Name = „Nutzgraddiagramm“
Range(„H27“).Select
ActiveSheet.ChartObjects(„Nutzgraddiagramm“).Activate
ActiveChart.SeriesCollection(2).Select
ActiveChart.SeriesCollection(2).ChartType = xlLine
ActiveChart.SeriesCollection(2).Select
With Selection.Border
.ColorIndex = 4
.Weight = xlThick
.LineStyle = xlContinuous
End With
With Selection
.MarkerBackgroundColorIndex = xlNone
.MarkerForegroundColorIndex = xlNone
.MarkerStyle = xlNone
.Smooth = False
.MarkerSize = 5
.Shadow = False
End With
With Selection.Border
.ColorIndex = 10
.Weight = xlThick
.LineStyle = xlContinuous
End With
With Selection
.MarkerBackgroundColorIndex = xlNone
.MarkerForegroundColorIndex = xlNone
.MarkerStyle = xlNone
.Smooth = False
.MarkerSize = 5
.Shadow = False
End With
ActiveChart.SeriesCollection(1).Select
With Selection.Border
.Weight = xlThin
.LineStyle = xlAutomatic
End With
Selection.Shadow = False
Selection.InvertIfNegative = False
With Selection.Interior
.ColorIndex = 37
.Pattern = xlSolid
End With
ActiveChart.SeriesCollection(1).Points(1).Select
With Selection.Border
.Weight = xlThin
.LineStyle = xlAutomatic
End With
Selection.Shadow = False
Selection.InvertIfNegative = False
With Selection.Interior
.ColorIndex = 41
.Pattern = xlSolid
End With
ActiveChart.ChartArea.Select
ActiveSheet.Shapes(„Nutzgraddiagramm“).IncrementLeft -48.75
ActiveSheet.Shapes(„Nutzgraddiagramm“).IncrementTop -6#
ActiveSheet.Shapes(„Nutzgraddiagramm“).ScaleWidth 1.58, msoFalse, _
msoScaleFromTopLeft
ActiveSheet.Shapes(„Nutzgraddiagramm“).ScaleHeight 1.29, msoFalse, _
msoScaleFromTopLeft
ActiveChart.SeriesCollection(2).Select
With Selection.Border
.ColorIndex = 3
.Weight = xlThick
.LineStyle = xlContinuous
End With
With Selection
.MarkerBackgroundColorIndex = xlNone
.MarkerForegroundColorIndex = xlNone
.MarkerStyle = xlNone
.Smooth = False
.MarkerSize = 5
.Shadow = False
End With
ActiveWindow.Visible = False
Windows("# Pareto + GAE-Potential # test.xls").Activate
Range(„A1:M1“).Select
End Sub
Schon mal Danke im Voraus,
ck
Hallo Christian,
ich habe ein Makro, dass mir aus einer Tabelle automatisch ein
Diagramm erzeugt.
heißt das nach jedem Durchlauf hast du ein Diahramm mehr auf dem Blatt?
Oder wird immer alte Diagramm gelöscht und einneues erzeugt aufgrund von geänderten Daten?
Hier mein Makro-Code, der nicht funktioniert, weil er sich auf
einen festen Diagramm-Namen bezieht:
Die vielen Select und das Nichtbenutzen des pre-Tags macht den Code schwer lesbar.
Unterhalb des Eingabefensters wird der pre-tag erläutert.
Stelle den Code nochmals ein, komplett. Falls nötig auch den Code des anderen Makros.
Wieso eigentlich 2 Makros?
Gruß
Reinhard
Hallo Reinhard,
zu erst mal danke für Deine Antwort.
Leider weiß ich nicht wie das mit dem pre-tag funktioniert.
Die 2 Makros haben keinen besonderen Zweck, wenn alles funktioniert, dann füge ich sie zusammen.
Das erste Makro soll - wenn ich das Diagramm dann auswählen kann - das vorhandene Diagramm löschen und ein neues, nach den neuen Daten, erzeugen.
Hier nochmal der Code:
ActiveSheet.Shapes(„Chart 29“).Select
Selection.Name = „Nutzgraddiagramm“
Range(„H27“).Select
ActiveSheet.ChartObjects(„Nutzgraddiagramm“).Activate
ActiveChart.SeriesCollection(2).Select
ActiveChart.SeriesCollection(2).ChartType = xlLine
ActiveChart.SeriesCollection(2).Select
With Selection.Border
.ColorIndex = 4
.Weight = xlThick
.LineStyle = xlContinuous
End With
With Selection
.MarkerBackgroundColorIndex = xlNone
.MarkerForegroundColorIndex = xlNone
.MarkerStyle = xlNone
.Smooth = False
.MarkerSize = 5
.Shadow = False
End With
With Selection.Border
.ColorIndex = 10
.Weight = xlThick
.LineStyle = xlContinuous
End With
With Selection
.MarkerBackgroundColorIndex = xlNone
.MarkerForegroundColorIndex = xlNone
.MarkerStyle = xlNone
.Smooth = False
.MarkerSize = 5
.Shadow = False
End With
ActiveChart.SeriesCollection(1).Select
With Selection.Border
.Weight = xlThin
.LineStyle = xlAutomatic
End With
Selection.Shadow = False
Selection.InvertIfNegative = False
With Selection.Interior
.ColorIndex = 37
.Pattern = xlSolid
End With
ActiveChart.SeriesCollection(1).Points(1).Select
With Selection.Border
.Weight = xlThin
.LineStyle = xlAutomatic
End With
Selection.Shadow = False
Selection.InvertIfNegative = False
With Selection.Interior
.ColorIndex = 41
.Pattern = xlSolid
End With
ActiveChart.ChartArea.Select
ActiveSheet.Shapes(„Nutzgraddiagramm“).IncrementLeft -48.75
ActiveSheet.Shapes(„Nutzgraddiagramm“).IncrementTop -6#
ActiveSheet.Shapes(„Nutzgraddiagramm“).ScaleWidth 1.58, msoFalse, _
msoScaleFromTopLeft
ActiveSheet.Shapes(„Nutzgraddiagramm“).ScaleHeight 1.29, msoFalse, _
msoScaleFromTopLeft
ActiveChart.SeriesCollection(2).Select
With Selection.Border
.ColorIndex = 3
.Weight = xlThick
.LineStyle = xlContinuous
End With
With Selection
.MarkerBackgroundColorIndex = xlNone
.MarkerForegroundColorIndex = xlNone
.MarkerStyle = xlNone
.Smooth = False
.MarkerSize = 5
.Shadow = False
End With
ActiveWindow.Visible = False
Windows("# Pareto + GAE-Potential # test.xls").Activate
Range(„A1:M1“).Select
End Sub
Hallo Christian,
Leider weiß ich nicht wie das mit dem pre-tag funktioniert.
du mußt nur oberhalb des Codes
und unterhalb des Codes
(ohne leerzeichen zusammengeschrieben) hinschreiben, dann bleiben die Einrückungen des Codes durch Leerzeichen erhalten. Wichtig für Schleifen usw.
Das erste Makro soll - wenn ich das Diagramm dann auswählen
kann - das vorhandene Diagramm löschen und ein neues, nach den
neuen Daten, erzeugen.
Hier nochmal der Code:
Ich bat dich komletten Code zu zeigen, da fehlt schon wieder der Anfang.
Ich bat dich den anderen Code zu zeigen. In dem Moment wo du per Makro ein Diagramm erstellst ist es wurscht wie Excel das benennt, man kann dann leicht darauf zugreifen ohne den namen zu kennen.
Natürlich kann man auch gezielt durch den namen auf ein Diagramm zugreifen, aber dann muß man den namen kennen wenn man mehrere Diagramme im Blatt hat, deshalb meine Nachfragen.
Gruß
Reinhard
Hallo Reinhard,
vor dem Code steht nur noch:
Sub Formatieren_Nutzgraddiagramm()
Auf den Code des ersten Makros kann ich zur Zeit leider nicht zugreifen, da ich ihn an der Arbeit habe.
>In dem Moment wo du per Makro ein Diagramm erstellst ist es wurscht wie Excel das benennt, man kann dann leicht darauf zugreifen ohne den namen zu kennen. Wie das geht, müsste ich wissen, ich glaube, dann habe ich alles was ich brauche.
Gruß
Christian
Hallo Christian,
vor dem Code steht nur noch:
Sub Formatieren_Nutzgraddiagramm()
dann zeige das doch. Hier gilt im Zweifel gegen den Anfrager 
Hätt ja sein können daß da noch mehr steht.
>In dem Moment wo du per Makro ein Diagramm erstellst ist es
wurscht wie Excel das benennt, man kann dann leicht darauf
zugreifen ohne den namen zu kennen. Wie das geht, müsste ich wissen, ich glaube, dann habe ich
alles was ich brauche.
Okay, dann zeige halt morgen das Andere makro.
Um auf Objekte eines Tabellneblattes zuzugreifen gibt es diverse Möglichkeiten, eine ist z.B.
Sub test()
With ActiveSheet.Shapes
MsgBox .Item(1).Name
End With
End Sub
Die funktioniert natürlich nicht wenn du mehrere Objekte im Blatt hast, Buttons, Schaltflächen o.ä.
Es gibt da einen Befehl, sowas wie „Type“ mit dem man den Typ des Objekts herausfindest.
Daurch könntest du wenn du mehrere Objekte im Blatt hast eine Schleife basteln die alle Objekte durchgeht und wenn dann das Objekt ein Diagramm ist mit IF…THEN darauf reagieren.
Dann ist es egal wie das Diagramm heißt.
Leider komme ich grad nicht auf den Namen des befehls den ich meine.
Vielleicht weiß ihn ja einer der Mitlesenden.
Hilft dir das weiter?
Gruß
Reinhard
Ich probier das mal aus und melde mich morgen wieder…
Leider habe ich das Problem noch nicht lösen können.
Hier der komplette Code beider Makros:
Sub Erstellen_Nutzgrad_Diagramm()
Sheets(„Daten“).Select
Range(„A3“).Select
ActiveSheet.Paste
Range(„B3:G10“).Select
Selection.ClearContents
Range(„H3:I10“).Select
Selection.Cut
Range(„B3“).Select
ActiveSheet.Paste
Range(„F1“).Select
Selection.Copy
Range(„C3:C10“).Select
ActiveSheet.Paste
Range(„G1“).Select
Application.CutCopyMode = False
Selection.Copy
Range(„D3:smiley:10“).Select
ActiveSheet.Paste
Range(„A3:G10“).Select
Application.CutCopyMode = False
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range(„E3:G10“).Select
Selection.Interior.ColorIndex = xlNone
Range(„A2:smiley:10“).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range(„A10“).Select
Selection.AutoFill Destination:=Range(„A10:A12“), Type:=xlFillDefault
Range(„A10:A12“).Select
Range(„D10“).Select
Selection.AutoFill Destination:=Range(„D10:smiley:12“), Type:=xlFillDefault
Range(„D10:smiley:12“).Select
Sheets(„Nutzgradbericht“).Select
Charts.Add
ActiveChart.ChartType = xlColumnClustered
ActiveChart.SetSourceData Source:=Sheets(„Nutzgradbericht“).Range(„B11“)
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(1).XValues = „=Daten!R2C1:R12C1“
ActiveChart.SeriesCollection(1).Values = „=Daten!R2C3:R10C3“
ActiveChart.SeriesCollection(1).Name = „=Daten!R1C3“
ActiveChart.SeriesCollection(2).Values = „=Daten!R2C4:R12C4“
ActiveChart.SeriesCollection(2).Name = „=Daten!R1C4“
ActiveChart.Location Where:=xlLocationAsObject, Name:=„Nutzgradbericht“
ActiveChart.HasLegend = True
ActiveChart.Legend.Select
Selection.Position = xlTop
ActiveChart.HasDataTable = False
End Sub
Sub Nutzgrad_Diagramm_formatieren()
Selection.Name = „Nutzgraddiagramm“
Range(„H27“).Select
ActiveSheet.ChartObjects(„Nutzgraddiagramm“).Activate
ActiveChart.SeriesCollection(2).Select
ActiveChart.SeriesCollection(2).ChartType = xlLine
ActiveChart.SeriesCollection(2).Select
With Selection.Border
.ColorIndex = 4
.Weight = xlThick
.LineStyle = xlContinuous
End With
With Selection
.MarkerBackgroundColorIndex = xlNone
.MarkerForegroundColorIndex = xlNone
.MarkerStyle = xlNone
.Smooth = False
.MarkerSize = 5
.Shadow = False
End With
With Selection.Border
.ColorIndex = 10
.Weight = xlThick
.LineStyle = xlContinuous
End With
With Selection
.MarkerBackgroundColorIndex = xlNone
.MarkerForegroundColorIndex = xlNone
.MarkerStyle = xlNone
.Smooth = False
.MarkerSize = 5
.Shadow = False
End With
ActiveChart.SeriesCollection(1).Select
With Selection.Border
.Weight = xlThin
.LineStyle = xlAutomatic
End With
Selection.Shadow = False
Selection.InvertIfNegative = False
With Selection.Interior
.ColorIndex = 37
.Pattern = xlSolid
End With
ActiveChart.SeriesCollection(1).Points(1).Select
With Selection.Border
.Weight = xlThin
.LineStyle = xlAutomatic
End With
Selection.Shadow = False
Selection.InvertIfNegative = False
With Selection.Interior
.ColorIndex = 41
.Pattern = xlSolid
End With
ActiveChart.ChartArea.Select
ActiveSheet.Shapes(„Nutzgraddiagramm“).IncrementLeft -48.75
ActiveSheet.Shapes(„Nutzgraddiagramm“).IncrementTop -6#
ActiveSheet.Shapes(„Nutzgraddiagramm“).ScaleWidth 1.58, msoFalse, _
msoScaleFromTopLeft
ActiveSheet.Shapes(„Nutzgraddiagramm“).ScaleHeight 1.29, msoFalse, _
msoScaleFromTopLeft
ActiveChart.SeriesCollection(2).Select
With Selection.Border
.ColorIndex = 3
.Weight = xlThick
.LineStyle = xlContinuous
End With
With Selection
.MarkerBackgroundColorIndex = xlNone
.MarkerForegroundColorIndex = xlNone
.MarkerStyle = xlNone
.Smooth = False
.MarkerSize = 5
.Shadow = False
End With
ActiveWindow.Visible = False
Windows("# Pareto + GAE-Potential # test.xls").Activate
Range(„A1:M1“).Select
End Sub
Hallo Christian,
was bitteschön ist daran unverständlich bzw. nicht nachvollziehbar?:
"du mußt nur oberhalb des Codes
und unterhalb des Codes
(ohne leerzeichen zusammengeschrieben) hinschreiben, dann bleiben die Einrückungen des Codes durch Leerzeichen erhalten. Wichtig für Schleifen usw."
Gruß
Reinhard
Sub Erstellen\_Nutzgrad\_Diagramm()
Sheets("Daten").Select
Range("A3").Select
ActiveSheet.Paste
Range("B3:G10").Select
Selection.ClearContents
Range("H3:I10").Select
Selection.Cut
Range("B3").Select
ActiveSheet.Paste
Range("F1").Select
Selection.Copy
Range("C3:C10").Select
ActiveSheet.Paste
Range("G1").Select
Application.CutCopyMode = False
Selection.Copy
Range("D3:smiley:10").Select
ActiveSheet.Paste
Range("A3:G10").Select
Application.CutCopyMode = False
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("E3:G10").Select
Selection.Interior.ColorIndex = xlNone
Range("A2:smiley:10").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("A10").Select
Selection.AutoFill Destination:=Range("A10:A12"), Type:=xlFillDefault
Range("A10:A12").Select
Range("D10").Select
Selection.AutoFill Destination:=Range("D10:smiley:12"), Type:=xlFillDefault
Range("D10:smiley:12").Select
Sheets("Nutzgradbericht").Select
Charts.Add
ActiveChart.ChartType = xlColumnClustered
ActiveChart.SetSourceData Source:=Sheets("Nutzgradbericht").Range("B11")
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(1).XValues = "=Daten!R2C1:R12C1"
ActiveChart.SeriesCollection(1).Values = "=Daten!R2C3:R10C3"
ActiveChart.SeriesCollection(1).Name = "=Daten!R1C3"
ActiveChart.SeriesCollection(2).Values = "=Daten!R2C4:R12C4"
ActiveChart.SeriesCollection(2).Name = "=Daten!R1C4"
ActiveChart.Location Where:=xlLocationAsObject, Name:="Nutzgradbericht"
ActiveChart.HasLegend = True
ActiveChart.Legend.Select
Selection.Position = xlTop
ActiveChart.HasDataTable = False
End Sub
---
Sub Nutzgrad\_Diagramm\_formatieren()
ActiveSheet.Shapes("Chart 29").Select
Selection.Name = "Nutzgraddiagramm"
Range("H27").Select
ActiveSheet.ChartObjects("Nutzgraddiagramm").Activate
ActiveChart.SeriesCollection(2).Select
ActiveChart.SeriesCollection(2).ChartType = xlLine
ActiveChart.SeriesCollection(2).Select
With Selection.Border
.ColorIndex = 4
.Weight = xlThick
.LineStyle = xlContinuous
End With
With Selection
.MarkerBackgroundColorIndex = xlNone
.MarkerForegroundColorIndex = xlNone
.MarkerStyle = xlNone
.Smooth = False
.MarkerSize = 5
.Shadow = False
End With
With Selection.Border
.ColorIndex = 10
.Weight = xlThick
.LineStyle = xlContinuous
End With
With Selection
.MarkerBackgroundColorIndex = xlNone
.MarkerForegroundColorIndex = xlNone
.MarkerStyle = xlNone
.Smooth = False
.MarkerSize = 5
.Shadow = False
End With
ActiveChart.SeriesCollection(1).Select
With Selection.Border
.Weight = xlThin
.LineStyle = xlAutomatic
End With
Selection.Shadow = False
Selection.InvertIfNegative = False
With Selection.Interior
.ColorIndex = 37
.Pattern = xlSolid
End With
ActiveChart.SeriesCollection(1).Points(1).Select
With Selection.Border
.Weight = xlThin
.LineStyle = xlAutomatic
End With
Selection.Shadow = False
Selection.InvertIfNegative = False
With Selection.Interior
.ColorIndex = 41
.Pattern = xlSolid
End With
ActiveChart.ChartArea.Select
ActiveSheet.Shapes("Nutzgraddiagramm").IncrementLeft -48.75
ActiveSheet.Shapes("Nutzgraddiagramm").IncrementTop -6#
ActiveSheet.Shapes("Nutzgraddiagramm").ScaleWidth 1.58, msoFalse, \_
msoScaleFromTopLeft
ActiveSheet.Shapes("Nutzgraddiagramm").ScaleHeight 1.29, msoFalse, \_
msoScaleFromTopLeft
ActiveChart.SeriesCollection(2).Select
With Selection.Border
.ColorIndex = 3
.Weight = xlThick
.LineStyle = xlContinuous
End With
With Selection
.MarkerBackgroundColorIndex = xlNone
.MarkerForegroundColorIndex = xlNone
.MarkerStyle = xlNone
.Smooth = False
.MarkerSize = 5
.Shadow = False
End With
ActiveWindow.Visible = False
End Sub
Gruß
Christian
Hallo Christian,
probier das mal so:
Option Explicit
'
Sub Erstellen\_Nutzgrad\_Diagramm()
Dim N As Integer
With Worksheets("Daten")
.Range("B3:G10").ClearContents
.Range("H3:I10").Cut Destination:=.Range("B3")
.Range("F1").Copy Destination:=.Range("C3:C10")
.Range("G1").Copy Destination:=.Range("D3:smiley:10")
With .Range("A3:G10")
For N = 5 To 12
.Borders(N).LineStyle = xlNone
Next N
End With
.Range("E3:G10").Interior.ColorIndex = xlNone
With .Range("A2:smiley:10")
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
For N = 7 To 12
.Borders(N).LineStyle = xlNone
Next N
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
.Range("A10").AutoFill Destination:=.Range("A10:A12"), Type:=xlFillDefault
.Range("D10").AutoFill Destination:=.Range("D10:smiley:12"), Type:=xlFillDefault
End With
Sheets("Nutzgradbericht").Select
Charts.Add
With ActiveChart
.Name = "Nutzgraddiagramm"
.ChartType = xlColumnClustered
.SetSourceData Source:=Sheets("Nutzgradbericht").Range("B11")
.SeriesCollection.NewSeries
.SeriesCollection.NewSeries
.SeriesCollection(1).XValues = "=Daten!R2C1:R12C1"
.SeriesCollection(1).Values = "=Daten!R2C3:R10C3"
.SeriesCollection(1).Name = "=Daten!R1C3"
.SeriesCollection(2).Values = "=Daten!R2C4:R12C4"
.SeriesCollection(2).Name = "=Daten!R1C4"
.Location Where:=xlLocationAsObject, Name:="Nutzgradbericht"
.HasLegend = True
.Legend.Select
'Selection.Position = xlTop 'muß noch referenziert werden!
.HasDataTable = False
End With
End Sub
'
Sub Nutzgrad\_Diagramm\_formatieren()
ActiveSheet.ChartObjects("Nutzgraddiagramm").Activate
ActiveChart.SeriesCollection(2).Select
ActiveChart.SeriesCollection(2).ChartType = xlLine
ActiveChart.SeriesCollection(2).Select
With Selection.Border
.ColorIndex = 4
.Weight = xlThick
.LineStyle = xlContinuous
End With
With Selection
.MarkerBackgroundColorIndex = xlNone
.MarkerForegroundColorIndex = xlNone
.MarkerStyle = xlNone
.Smooth = False
.MarkerSize = 5
.Shadow = False
End With
With Selection.Border
.ColorIndex = 10
.Weight = xlThick
.LineStyle = xlContinuous
End With
With Selection
.MarkerBackgroundColorIndex = xlNone
.MarkerForegroundColorIndex = xlNone
.MarkerStyle = xlNone
.Smooth = False
.MarkerSize = 5
.Shadow = False
End With
ActiveChart.SeriesCollection(1).Select
With Selection.Border
.Weight = xlThin
.LineStyle = xlAutomatic
End With
Selection.Shadow = False
Selection.InvertIfNegative = False
With Selection.Interior
.ColorIndex = 37
.Pattern = xlSolid
End With
ActiveChart.SeriesCollection(1).Points(1).Select
With Selection.Border
.Weight = xlThin
.LineStyle = xlAutomatic
End With
Selection.Shadow = False
Selection.InvertIfNegative = False
With Selection.Interior
.ColorIndex = 41
.Pattern = xlSolid
End With
ActiveChart.ChartArea.Select
ActiveSheet.Shapes("Nutzgraddiagramm").IncrementLeft -48.75
ActiveSheet.Shapes("Nutzgraddiagramm").IncrementTop -6#
ActiveSheet.Shapes("Nutzgraddiagramm").ScaleWidth 1.58, msoFalse, \_
msoScaleFromTopLeft
ActiveSheet.Shapes("Nutzgraddiagramm").ScaleHeight 1.29, msoFalse, \_
msoScaleFromTopLeft
ActiveChart.SeriesCollection(2).Select
With Selection.Border
.ColorIndex = 3
.Weight = xlThick
.LineStyle = xlContinuous
End With
With Selection
.MarkerBackgroundColorIndex = xlNone
.MarkerForegroundColorIndex = xlNone
.MarkerStyle = xlNone
.Smooth = False
.MarkerSize = 5
.Shadow = False
End With
ActiveWindow.Visible = False
End Sub
Gruß
Reinhard
Hallo Reinhard,
leider funktioniert der Code überhaupt nicht.
Der erste Teil zerschießt mit die Datentabelle, so dass das Diagramm nicht mehr richtig angezeigt wird. Und leider bekommt das Diagramm auch nicht den Namen „Nutzgraddiagramm“, so dass das darauf folgende Formatierungs-Makro keinen Bezug zum Diagramm herstellen kann.
Ich bin ratlos.
Gruß
Christian