Hallo an alle,
hat jemand eine Idee wie ich diesen Code optimieren kann,
'**** Hier werden bestimmte stellen auf der Coordinates Seite ausgemacht ****'
intStartCoor = Zelle_suchen_Spalte("Lfd.Nr.", 1, 1, 50, "Coordinates")
intZeile1 = intStartCoor + 1
intSpalte1 = 4
intZeile2 = Worksheets("Coordinates").Cells(17, 3).Value + intStartCoor
intSpalte2 = 5
'**** Hier wird ein Standard Diagramm erstellt ***'
Worksheets("Layout2").Activate
With Sheets("Layout2")
.ChartObjects.Add(0, 0, 630, 630).Name = "Dia2" '** Diagrammgröße und Diagrammname
With .ChartObjects("Dia2").Chart
.ChartType = xlXYScatter '*** Diagrammtyp
.SetSourceData Source:=Sheets("Coordinates").Range _
(Sheets("Coordinates").Cells(intStartCoor + 1, 4), Sheets("Coordinates").Cells _
(intZeile2, 5)), PlotBy:=xlColumns '*** Datenbereich
.HasLegend = False '*** Legende ausschalten
End With
End With
'**** Die Pads werden erstellt ***'
ActiveSheet.ChartObjects("Dia2").Activate
ActiveChart.SeriesCollection(1).Select
With Selection.Border
.Weight = xlHairline
.LineStyle = xlNone
End With
With Selection
.MarkerBackgroundColorIndex = xlAutomatic
.MarkerForegroundColorIndex = xlAutomatic
.MarkerStyle = xlSquare
.Smooth = False
.MarkerSize = 6
.Shadow = False
End With
'*** Die X-Achse einstellen
ActiveChart.Axes(xlCategory).Select
With ActiveChart.Axes(xlCategory)
.MinimumScale = -200
.MaximumScale = intText1 + 200
.MinorUnitIsAuto = True
.MajorUnitIsAuto = True
.Crosses = xlAutomatic
.ReversePlotOrder = False
.ScaleType = xlLinear
.DisplayUnit = xlNone
End With
'*** Die Y-Achse einstellen
ActiveChart.Axes(xlValue).Select
With ActiveChart.Axes(xlValue)
.MinimumScale = -200
.MaximumScale = intText2 + 200
.MinorUnitIsAuto = True
.MajorUnitIsAuto = True
.Crosses = xlAutomatic
.ReversePlotOrder = False
.ScaleType = xlLinear
.DisplayUnit = xlNone
End With
'*** Achsen ausschalten
With ActiveChart
.HasAxis(xlCategory, xlPrimary) = False
.HasAxis(xlValue, xlPrimary) = False
End With
'*** Hilfslinien ausschalten
ActiveChart.PlotArea.Select
With ActiveChart.Axes(xlCategory)
.HasMajorGridlines = False
.HasMinorGridlines = False
End With
With ActiveChart.Axes(xlValue)
.HasMajorGridlines = False
.HasMinorGridlines = False
End With
Dim i As Integer
Dim a As Integer
a = 1
With ActiveSheet.ChartObjects("Dia2").Chart.SeriesCollection(1)
.HasDataLabels = True
.MarkerStyle = xlNone
For i = intStartCoor + 1 To intZeile2
With .Points(i - intStartCoor).DataLabel
.text = Worksheets("Coordinates").Cells(i, 3).Value
.Font.Size = intFontSize
End With
Next
End With
kann man diese Funktionen auch zusammen schreiben?
kleiner?
Wenn ja möchte ich euch bitten mir
dieses zu zeigen möglichst mit vielen
Kommentaren? damit ich auch lernen kann!
Vielen Dank!
Gruß
Swen