AW: Probleme mit einem Diagramm ( ... über ein Jahr )
25.05.2006 14:06:46
Swen
Hallo an alle,
so habe ich es bisher gemacht!!!!
'**** Diagramm mit Lötpunkten erstellen *****'
'**** Nadeln ziehen'
With Worksheets(PCBName)
ModulFunktion1.Diagramm_erstellen .Range(.Cells(3, 2), .Cells(.Cells(1, 2) + 2, 3))
ActiveSheet.ChartObjects(ActiveSheet.ChartObjects.Count).Activate
ActiveChart.SeriesCollection(1).Select
With Selection.Border
.Weight = xlHairline
.LineStyle = xlNone
End With
With Selection
.MarkerBackgroundColorIndex = 44
.MarkerForegroundColorIndex = 46
.MarkerStyle = xlCircle
.MarkerSize = 5
End With
Set chrt = .ChartObjects(1).Chart
intZaehler22 = 2
' "alte" Nadeln löschen
On Error Resume Next
For intZaehler = chrt.SeriesCollection.Count To 2 Step -1
chrt.SeriesCollection.Item(intZaehler).Delete
Next
On Error GoTo 0
For intZaehler = 3 To .Cells(1, 2).Value + 2
If .Cells(intZaehler, 6).Value = "*" Then
chrt.SeriesCollection.NewSeries
chrt.SeriesCollection(intZaehler22).XValues = "{" & .Cells(intZaehler, 2) & "," & .Cells(intZaehler, 4) & "}"
chrt.SeriesCollection(intZaehler22).Values = "{" & .Cells(intZaehler, 3) & "," & .Cells(intZaehler, 5) & "}"
chrt.SeriesCollection(intZaehler22).Name = .Cells(intZaehler, 1).Value
chrt.SeriesCollection(intZaehler22).ApplyDataLabels Type:=xlDataLabelsShowLabel
chrt.SeriesCollection(intZaehler22).DataLabels.Item(1).Text = .Cells(intZaehler, 1).Text
chrt.SeriesCollection(intZaehler22).DataLabels.Item(1).Position = IIf((.Cells(intZaehler, 3) Or .Cells(intZaehler, 5)) > 0, xlLabelPositionAbove, xlLabelPositionBelow)
chrt.SeriesCollection(intZaehler22).DataLabels.Item(1).Font.Size = intFontSize
chrt.SeriesCollection(intZaehler22).DataLabels.Item(1).Font.ColorIndex = 5
chrt.SeriesCollection(intZaehler22).DataLabels.Item(2).Delete
chrt.SeriesCollection(intZaehler22).ChartType = xlXYScatterLinesNoMarkers
chrt.SeriesCollection(intZaehler22).Border.ColorIndex = 5
chrt.SeriesCollection(intZaehler22).MarkerStyle = xlNone
intZaehler22 = intZaehler22 + 1
End If
Next intZaehler
End With
With Worksheets(PCBName)
.Range("A1").Select
.Select
.Name = "Layout3"
End With
With Worksheets("Layout3").Columns("A:F").Font
.Name = "Arial"
.FontStyle = "Standard"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 2
End With
Worksheets("Layout3").Range("A1").Select
'**********************************
'******* Aus dem ModulFunktion1
***********************************
Sub Diagramm_erstellen(ByVal myRange As Range)
Charts.Add
ActiveChart.ChartType = xlXYScatter
ActiveChart.SetSourceData Source:=myRange, _
PlotBy:=xlColumns
ActiveChart.Location Where:=xlLocationAsObject, Name:=myRange.Parent.Name
With ActiveChart
.HasTitle = False
.Axes(xlCategory, xlPrimary).HasTitle = False
.Axes(xlValue, xlPrimary).HasTitle = False
End With
With ActiveChart.Axes(xlCategory)
.HasMajorGridlines = False
.HasMinorGridlines = False
End With
With ActiveChart.Axes(xlValue)
.HasMajorGridlines = False
.HasMinorGridlines = False
End With
ActiveChart.HasLegend = False
ActiveChart.ApplyDataLabels Type:=xlDataLabelsShowNone, LegendKey:=False
ActiveChart.Axes(xlCategory).Select
With Selection.Border
.LineStyle = xlNone
End With
With Selection
.MajorTickMark = xlNone
.MinorTickMark = xlNone
.TickLabelPosition = xlNextToAxis
End With
Selection.TickLabels.AutoScaleFont = False
With Selection.TickLabels.Font
.Name = "Tahoma"
.FontStyle = "Standard"
.Size = 8
.ColorIndex = 56
.Background = xlTransparent
End With
Selection.TickLabels.NumberFormat = "#,##0,"
Selection.TickLabels.Orientation = xlUpward
ActiveChart.Axes(xlValue).Select
With Selection.Border
.LineStyle = xlNone
End With
With Selection
.MajorTickMark = xlNone
.MinorTickMark = xlNone
.TickLabelPosition = xlNextToAxis
End With
Selection.TickLabels.AutoScaleFont = False
With Selection.TickLabels.Font
.Name = "Tahoma"
.FontStyle = "Standard"
.Size = 8
.ColorIndex = 56
.Background = xlTransparent
End With
Selection.TickLabels.NumberFormat = "#,##0,"
ActiveChart.PlotArea.Select
With Selection.Border
.LineStyle = xlNone
End With
Selection.Interior.ColorIndex = xlNone
ActiveChart.ChartArea.Select
With Selection.Border
.LineStyle = 0
End With
Selection.Fill.OneColorGradient Style:=msoGradientHorizontal, Variant:=2, _
Degree:=0.831357289997711
With Selection
.Fill.ForeColor.SchemeColor = 15
End With
ActiveSheet.Shapes(ActiveSheet.Shapes.Count).ScaleHeight 1.36, msoFalse, _
msoScaleFromTopLeft
ActiveSheet.Shapes(ActiveSheet.Shapes.Count).Top = 5
ActiveSheet.Shapes(ActiveSheet.Shapes.Count).Left = 5
ActiveSheet.Shapes(ActiveSheet.Shapes.Count).Width = 650
ActiveSheet.Shapes(ActiveSheet.Shapes.Count).Height = 650
ActiveChart.PlotArea.Select
Selection.Top = 1
Selection.Height = 499
Selection.Left = 1
Selection.Width = 499
End Sub