Range ändert sich bei aktiver Zelle in der Range
17.11.2024 16:06:55
Marci0804
ich programmiere derzeit in VBA ein Makro, welches mir Daten mit .Range aus einem Worksheet ausließt und anschließend zur Erzeugung eines Chartsheets nutzt. Nun habe ich bemerkt, dass sobald ich in dem Zellenbereich, auf den die .Range zugreift, eine Zelle auswähle und mein Makro laufen lasse einen Fehler bekomme. Ich vermute, dass die .Range anders eingelesen wird als wenn ich die Zelle nicht auswähle. Da das leider nicht wirklich User-freundlich ist, hoffe ich ihr könnt mir dabei helfen mein Problem zu lösen.
Der Fehler, den ich bekomme ist Laufzeitfehler 1004: Der Parameter ist ungültig und tritt in Zeile 191 auf. (With .Points(Range_cnt(color_cnt)) 'Datapoint-end-labels)
Hier habe ich einmal meinen Code:
Vielen Dank für Eure Hilfe!
Sub Creation_MS_REPORT_DIAGRAM()
'Definition of variables
Dim Range1 As Range 'Data for MS 1
Dim Range2 As Range 'Data for MS 2
Dim Range3 As Range 'Data for MS 3
Dim Range4 As Range 'Data for MS 4
Dim Range5 As Range 'Data for MS 5
Dim Range6 As Range 'Data for MS 6
Dim Range7 As Range 'Data for MS 7
Dim Xlabels As Range 'X axes labels
Dim Startdate As Range 'Startdate of Project
Dim Enddate As Range 'Enddate of Project
Dim Diag_entries As Range 'Datapoints for the diagonale
Dim MS_Diag As Chart 'ChartObject
Dim color(6) As Long 'To select the color for each MS
Dim color_cnt As Integer 'Counter for cycling through MS colors
Dim Datalabel_data_begin(6) As Long 'To select the MS beginn dates
Dim Datalabel_data_end(6) As Long 'To select the MS end dates
Dim Datalabel_cnt As Integer 'Counter for Datalabels
Dim ser As series 'To harmonise all MS lines and Markers
Dim row_cnt As Integer 'Counter for cycling through ranges
Dim Range_cnt(6) As Integer 'Length of the MS ranges
Dim Plotarea_width As Integer 'Width of the plotarea
Dim Plotarea_height As Integer 'Height of the plotarea
'Definition of constants
color_cnt = 0
Plotarea_width = 550
Plotarea_height = 450
Set Startdate = ThisWorkbook.Sheets("Back-End").Range("A3")
Set Enddate = ThisWorkbook.Sheets("Back-End").Range("A4")
'Select database
With Sheets("Back-End")
'XValues
Set Xlabels = .Range("B3:B" & .Range("A52").Value + 2)
'MS 1
Set Range1 = .Range("C2:C" & .Range("A52").Value + 2)
'MS 2
Set Range2 = .Range("D2:D" & .Range("A52").Value + 2)
'MS 3
Set Range3 = .Range("E2:E" & .Range("A52").Value + 2)
'MS 4
Set Range4 = .Range("F2:F" & .Range("A52").Value + 2)
'MS 5
Set Range5 = .Range("G2:G" & .Range("A52").Value + 2)
'MS 6
Set Range6 = .Range("H2:H" & .Range("A52").Value + 2)
'MS 7
Set Range7 = .Range("I2:I" & .Range("A52").Value + 2)
End With
'Create ChartSheet
ThisWorkbook.Charts.Add After:=Worksheets("Back-End")
'Set MS Diagram
Set MS_Diag = ThisWorkbook.Charts(1)
'Propertys of the MS diagram
With MS_Diag
'Type of diagram
.ChartType = xlLineMarkers
'Name
.Name = ThisWorkbook.Sheets("MS_REPORT").Range("B12")
'Set database
.SetSourceData Source:=Union(Range1, Range2, Range3, Range4, Range5, Range6, Range7)
'X-Axis range
.SeriesCollection(1).XValues = Xlabels
.Axes(xlCategory).MinimumScale = Startdate
.Axes(xlCategory).MaximumScale = Enddate
'Y-Axis range
.Axes(xlValue).MinimumScale = Startdate
.Axes(xlValue).MaximumScale = Enddate
.Axes(xlValue).MajorUnit = (Enddate - Startdate) / 5
.Axes(xlValue).MinorUnit = (Enddate - Startdate) / 15
.Axes(xlValue).Delete
'Axes-labels
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Reporting Periode"
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Project Periode / MS Date"
.Axes(xlValue, xlPrimary).AxisTitle.Left = 0
'Resize PlotArea square & centering
With .PlotArea
.Left = (MS_Diag.ChartArea.Width - Plotarea_width) / 2 'centering
.Width = Plotarea_width
.Height = Plotarea_height
End With
'Grid
.Axes(xlCategory).HasMajorGridlines = True
.Axes(xlCategory).MajorGridlines.Border.Weight = xlHairline
.Axes(xlValue).MajorGridlines.Border.Weight = 1
.Axes(xlValue).HasMinorGridlines = True
.Axes(xlValue).MinorGridlines.Border.Weight = 0.6
'MS-colors
color(0) = RGB(204, 0, 204)
color(1) = RGB(0, 0, 204)
color(2) = RGB(0, 204, 204)
color(3) = RGB(0, 204, 0)
color(4) = RGB(204, 204, 0)
color(5) = RGB(204, 102, 0)
color(6) = RGB(204, 0, 0)
'MS-Datalabels (begin)
Datalabel_data_begin(0) = Range1(2)
Datalabel_data_begin(1) = Range2(2)
Datalabel_data_begin(2) = Range3(2)
Datalabel_data_begin(3) = Range4(2)
Datalabel_data_begin(4) = Range5(2)
Datalabel_data_begin(5) = Range6(2)
Datalabel_data_begin(6) = Range7(2)
'MS-Datalabels (end)
For row_cnt = 2 To Range6.Count 'Check every row for #NV to get the number of entries
If Range1(row_cnt).Text > "#NV" Then
Range_cnt(0) = Range_cnt(0) + 1 'set max date of MS 1
End If
If Range2(row_cnt).Text > "#NV" Then
Range_cnt(1) = Range_cnt(1) + 1 'set max date of MS 2
End If
If Range3(row_cnt).Text > "#NV" Then
Range_cnt(2) = Range_cnt(2) + 1 'set max date of MS 3
End If
If Range4(row_cnt).Text > "#NV" Then
Range_cnt(3) = Range_cnt(3) + 1 'set max date of MS 4
End If
If Range5(row_cnt).Text > "#NV" Then
Range_cnt(4) = Range_cnt(4) + 1 'set max date of MS 5
End If
If Range6(row_cnt).Text > "#NV" Then
Range_cnt(5) = Range_cnt(5) + 1 'set max date of MS 6
End If
If Range7(row_cnt).Text > "#NV" Then
Range_cnt(6) = Range_cnt(6) + 1 'set max date of MS 7
End If
Next row_cnt
Datalabel_data_end(0) = Range1(Range_cnt(0) + 1)
Datalabel_data_end(1) = Range2(Range_cnt(1) + 1)
Datalabel_data_end(2) = Range3(Range_cnt(2) + 1)
Datalabel_data_end(3) = Range4(Range_cnt(3) + 1)
Datalabel_data_end(4) = Range5(Range_cnt(4) + 1)
Datalabel_data_end(5) = Range6(Range_cnt(5) + 1)
Datalabel_data_end(6) = Range7(Range_cnt(6) + 1)
'Edit MS-lines properties
For Each ser In .SeriesCollection
With ser
.Border.Weight = 3 'Thickness
.MarkerStyle = xlMarkerStyleDiamond 'Trianlge style
.Format.Fill.ForeColor.RGB = color(color_cnt) 'Markercolor
.Format.Line.ForeColor.RGB = color(color_cnt) 'Linecolor
.Format.Line.ForeColor.TintAndShade = -0.2 'Shade
With .Points(1) 'Datapoint-begin-labels
.HasDataLabel = True
.DataLabel.Text = ThisWorkbook.Sheets("Back-End").Cells(2, color_cnt + 3) & ": " & Format(Datalabel_data_begin(Datalabel_cnt), "dd.mm.yyyy")
.DataLabel.Position = xlLabelPositionLeft
.DataLabel.Font.color = color(color_cnt)
.DataLabel.Font.Bold = True
End With
With .Points(Range_cnt(color_cnt)) 'Datapoint-end-labels
.HasDataLabel = True
.DataLabel.Text = Format(Datalabel_data_end(Datalabel_cnt), "dd.mm.yyyy")
.DataLabel.Position = xlLabelPositionRight
.DataLabel.Font.color = color(color_cnt)
.DataLabel.Font.Bold = True
End With
End With
color_cnt = color_cnt + 1 'Augment running variable for color
Datalabel_cnt = Datalabel_cnt + 1 'Augment running variable for datalabel
Next
'Add diagonal
.SeriesCollection.Add Source:=Xlabels 'Set data source
.SeriesCollection(8).Border.Weight = 2 'Thickness
.SeriesCollection(8).MarkerStyle = xlNone 'No markers
.SeriesCollection(8).Format.Line.ForeColor.RGB = RGB(0, 0, 0) 'Linecolor black
.Legend.LegendEntries(8).Delete 'No legend entry
End With
End SubAnzeige