Makro in Klassenmodul geht nicht
16.07.2006 06:34:33
Thomas
Folger Code geht wunderbar in einem Modul.
Er soll aber aus einem Klassenmdul durchgeführt werden.
Leider bekomme ich immer Fehler 400 - Laufzeitfehler 1004.
Der Code bleibt bei (denke ich):
Set RangTimeSeries(x, m) = Sheets(quelle(x)).Range(Cells(Startzeile(x), TimeRow(x, a)), Cells(y(x, m), TimeRow(x, a)))
RangTimeSeries(x, m) ist ein range objekt.
Geht das nicht in einem Klassenmodul ?
--------------------------------
Sub Zeit_s_in_Diagram()
Application.StatusBar = "Zeit in Diagrammen wird geändert[s] ..."
'On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim targetsheets(1 To 19) As String
Dim quelle(1 To 19) As String
Dim Chart(1 To 19) As Integer
Dim TimeRow(1 To 19, 1 To 50) As Integer
Dim NumberSeries(1 To 19, 1 To 50) As Integer
Dim Startzeile(1 To 19) As Integer
Dim y(1 To 19, 1 To 50) As Integer
Dim RangTimeSeries(1 To 19, 1 To 50) As Range
Dim Rang As Range
Application.StatusBar = "Zeit in Diagrammen wird geändert [hh:mm:ss]..."
On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'Zeit von Series ändern
TimeRow(1, 1) = 3
TimeRow(1, 2) = 12
TimeRow(2, 1) = 20
TimeRow(2, 2) = 38
TimeRow(2, 3) = 56
TimeRow(3, 1) = 34
TimeRow(3, 2) = 38
etc..
targetsheets(1) = "Diag_Temperaturen"
targetsheets(2) = "Diag_T_Ref"
targetsheets(3) = "Diag_KW_Durchfluss"
etc...
Chart(1) = 2
Chart(2) = 3
Chart(3) = 3
etc...
NumberSeries(1, 1) = 6
NumberSeries(2, 1) = 2
NumberSeries(2, 2) = 4
NumberSeries(3, 1) = 1
NumberSeries(3, 2) = 2
NumberSeries(4, 1) = 50
NumberSeries(5, 1) = 50
NumberSeries(6, 1) = 50
NumberSeries(7, 1) = 50
NumberSeries(8, 1) = 50
NumberSeries(9, 1) = 3
etc....
Startzeile(1) = 4
Startzeile(2) = 4
Startzeile(3) = 5
Startzeile(4) = 4
etc....
' Abgekuerzt, hier werden die sheets erkannt
For Each objS In ActiveWorkbook.Worksheets
If objS.Name Like "Werte_Temp*" Then
' If Not objS.Name Like "Reformereinheit*" And Not objS.Name Like "Ref_Einheit*" Then
Set Werte_Temp = objS
' End If
Exit For
End If
Next
etc......
quelle(1) = "Werte_Temp"
quelle(2) = "Werte_Temp"
quelle(3) = "Werte_Durchfl"
quelle(4) = "Werte_Temp"
...etc
For x = 1 To 19
a = 1
Sheets(targetsheets(x)).Select
z = ActiveChart.SeriesCollection.Count
For m = 1 To ActiveChart.SeriesCollection.Count
Sheets(quelle(x)).Select
MsgBox "Fehler"
y(x, m) = Sheets(quelle(x)).Cells(Rows.Count, TimeRow(x, a)).End(xlUp).Row
'MsgBox "Fehler1"
Set RangTimeSeries(x, m) = Sheets(quelle(x)).Range(Cells(Startzeile(x), TimeRow(x, a)), Cells(y(x, m), TimeRow(x, a)))
Sheets(targetsheets(x)).Select
'If m < ActiveChart.SeriesCollection.Count Then
ActiveChart.SeriesCollection(m).XValues = RangTimeSeries(x, m)
'End If
If m = z And ActiveChart.SeriesCollection(m).Name = "Lastvorlage" Then
Sheets("Protokoll").Select
Rang = Sheets("Protokoll").Range("Z13:Z113")
Sheets(targetsheets(x)).Select
ActiveChart.SeriesCollection(m).XValues = Rang
End If
If m = z And Not ActiveChart.SeriesCollection(m).Name = "Lastvorlage" Then
Sheets(targetsheets(x)).Select
ActiveChart.SeriesCollection(m).XValues = RangTimeSeries(x, m)
End If
If m = NumberSeries(x, a) Then
a = a + 1
End If
Next m
Next x
For Each objS In Sheets
If Not objS.Type = -4167 Then
objS.Select
Range1 = Sheets("Protokoll").Cells(3, 10)
Range2 = Sheets("Protokoll").Cells(4, 10)
With ActiveChart.Axes(xlCategory)
.MinimumScale = Range1
.MaximumScale = Range2
.MinorUnitIsAuto = True
.MajorUnitIsAuto = True
.Crosses = xlAutomatic
.ReversePlotOrder = False
.ScaleType = xlLinear
.DisplayUnit = xlNone
End With
ActiveChart.Axes(xlCategory).Select
Selection.TickLabels.NumberFormat = "0"
End If
Next
Sheets("Protokoll").Select
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.StatusBar = False
End Sub
Vielen Dank
gruss Thomas