AW: Variablen von einem Sub im anderen verwenden
08.06.2006 14:28:07
einem
Die Variablen iRowDatBeg, iRowDatEnd und iRowWeek brauche ich im Sub cmdOK_Click() und UserForm_Initialize() im Sub ZeilenAuslesen() weise ich diesen Variablen die Werte zu die auch in den anderen Subs gebraucht werden. iRowWeek ändert sicht allerdings im Sub cmdOK_Click()
Hier ist der Code (kann komischerweise nicht uploaden):
Option Explicit
'Durchlaufvariablen deklarieren
Private i As Integer, i2 As Integer, i3 As Integer
Sub ZeilenAuslesen()
'Zeilen auslesen
Dim iRowDatBeg As Integer, iRowDatEnd As Integer, iRowWeek As Integer
'unterhalb dieser Zeile Beginnen die Daten
iRowDatBeg = 3
'Ende der Daten suchen
iRowDatEnd = iRowDatBeg
Do While Cells(iRowDatEnd + 1, 1).Value "" And _
Cells(iRowDatEnd + 1, 1).Value "Woche"
iRowDatEnd = iRowDatEnd + 1
Loop
'String "Woche" suchen
iRowWeek = iRowDatEnd
Do Until Cells(iRowWeek, 1).Value = "Woche"
iRowWeek = iRowWeek + 1
Loop
UserForm_Initialize iRowDatBeg, iRowDatEnd, iRowWeek
End Sub
Private Sub cmdOK_Click()
If iRowWeek - iRowDatEnd < 2 Then
Rows(iRowDatEnd).Insert Shift:=xlDown
Range("A" & iRowDatEnd + 1 & ":AP" & iRowDatEnd + 1).Interior.ColorIndex = 0
Range("A" & iRowDatEnd + 1 & ":AP" & iRowDatEnd + 1).Borders.LineStyle = xlContinuous
i = 7
Do While Cells(iRowDatEnd, i).Interior.Pattern < 17 And i <= 41
i = i + 1
Loop
Cells(iRowDatEnd, i).Interior.Pattern = 17
iRowWeek = iRowWeek + 1
End If
End Sub
Private Sub UserForm_Initialize(iRowDatBeg As Integer, iRowDatEnd As Integer, iRowWeek As Integer)
MsgBox iRowDatEnd
Dim aCProjektNr() As String
'Zeilen auslesen HINWEIS: Als Private außerhalb des Subs Definiert
'Dim iRowDatBeg As Integer, iRowDatEnd As Integer, iRowWeek As Integer
'PROJEKT-NR#############################################################
'Projekt-Nr. als String in ein Array schreiben
For i = 0 To iRowDatEnd - iRowDatBeg - 1
ReDim Preserve aCProjektNr(i) As String
aCProjektNr(i) = Cells(i + 1 + iRowDatBeg, 2).Value
Next i
'neues TB anlegen und Array-Werte eintragen
Worksheets.Add After:=Worksheets(1)
For i = 0 To UBound(aCProjektNr)
Worksheets(2).Cells(i + 1, 1) = aCProjektNr(i)
Next i
'Projekt-Nr. Array mit hilfe der Excel Sortierfunktion über ein neues TB sortieren
Worksheets(2).Range("A" & UBound(aCProjektNr)).Sort Key1:=Range("A1"), _
Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
'Array Sortiert wieder einlesen
For i = 0 To UBound(aCProjektNr)
aCProjektNr(i) = Worksheets(2).Cells(i + 1, 1).Value
Next i
'Sortier-TB wieder löschen
Application.DisplayAlerts = False
Worksheets(2).Delete
Application.DisplayAlerts = True
'Dialog mit Projekt-Nr befüllen
For i = 0 To UBound(aCProjektNr)
Me.CProjektNr.AddItem (aCProjektNr(i))
Next i
'ENDE PROJEKT-NR########################################################
With Me
.cmdCancel.Cancel = True
.cmdOK.Default = True
End With
End Sub