AW: Grösse der UserForm reagiert träge
25.02.2007 17:44:31
Gregor
Hallo Jan
Hier mein Code:
Private Sub UserForm_Activate()
Spalte_Gleis = Worksheets("Master Datei").Rows(1).Find("Gleis", LookAt:=xlWhole).Column
'--- setzt die Courserposition an den Anfang
Cells(ActiveCell.Row, 1).Select
If ActiveCell <> "" Then Name = ActiveCell
AnzZeilen = 1
If ActiveCell = "" Then
'--- Zeile der nächst beschriebenen Zelle
Zeile = ActiveCell.End(xlUp).Row
Name = Cells(Zeile, 1)
Gleis = Cells(Zeile, Spalte_Gleis).Value
AnzZeilen = ActiveCell.End(xlDown).Row
AnzZeilen = AnzZeilen - Zeile
End If
Zehner = 10
'---Controls füllen max. bis Zähler = 4
For intZeile = 0 To AnzZeilen - 1
Zähler = 0
For intSpalte = 38 To 52 Step 2 ' Spalten AL:AZ in 2er-Schritten
If Cells(Zeile + intZeile, intSpalte) > 0 Then
Zähler = Zähler + 1
Me.Controls("txtGleis" & Zähler + intZeile) = "Gleis " & Cells(Zeile + intZeile, Spalte_Gleis) & " Nutzlänge " & Cells(Zeile + intZeile, Spalte_Nutzlänge) & " Meter"
Me.Controls("txtP" & Zehner & Zähler) = Cells(1, intSpalte)
Me.Controls("txtL" & Zehner & Zähler) = Cells(Zeile + intZeile, intSpalte)
' Me.Controls("txtL" & Zähler) = Format(Cells(Zeile, intSp), "0.00") 'mit Format
Me.Controls("txtI" & Zehner & Zähler) = Cells(Zeile + intZeile, intSpalte + 1)
Me.Controls("lbl" & Zähler) = "Höhe Länge Index"
Zähler1 = Zähler
If Zähler >= 4 Then Exit For
End If
Next intSpalte
'---falls Zähler < 4, restliche Controls leeren
For intSpalte = Zähler + 1 To 4
Me.Controls("txtP" & Zehner & intSpalte) = ""
Me.Controls("txtL" & Zehner & intSpalte) = ""
Me.Controls("txtI" & Zehner & intSpalte) = ""
Me.Controls("lbl" & intSpalte) = ""
Next intSpalte
Zehner = Zehner + 10
If intZeile >= 18 Then Exit For
Next intZeile
'With Me
If Zähler1 = 1 Then usrPerronhöhen.Width = 275
If Zähler1 = 2 Then usrPerronhöhen.Width = 381
If Zähler1 = 3 Then usrPerronhöhen.Width = 489
If Zähler1 = 4 Then usrPerronhöhen.Width = 597
' .Repaint
'End With
intZeile1 = intZeile
'---falls intZeile < 7, restliche Controls leeren
For intZeile = intZeile To 6
Zähler = 1
Me.Controls("txtGleis" & Zähler + intZeile) = ""
Me.Controls("txtP" & Zehner & Zähler) = ""
Me.Controls("txtL" & Zehner & Zähler) = ""
Me.Controls("txtI" & Zehner & Zähler) = ""
Zehner = Zehner + 10
Zähler = Zähler + 1
Next intZeile
Me.txtTitel.Value = Name
'With Me
If intZeile1 = 1 Then usrPerronhöhen.Height = 106
If intZeile1 = 2 Then usrPerronhöhen.Height = 130
If intZeile1 = 3 Then usrPerronhöhen.Height = 155
If intZeile1 = 4 Then usrPerronhöhen.Height = 177
If intZeile1 = 5 Then usrPerronhöhen.Height = 202
If intZeile1 = 6 Then usrPerronhöhen.Height = 225
If intZeile1 = 7 Then usrPerronhöhen.Height = 250
If intZeile1 = 8 Then usrPerronhöhen.Height = 275
If intZeile1 = 9 Then usrPerronhöhen.Height = 298
If intZeile1 = 10 Then usrPerronhöhen.Height = 321
If intZeile1 = 11 Then usrPerronhöhen.Height = 345
If intZeile1 = 12 Then usrPerronhöhen.Height = 369
If intZeile1 = 13 Then usrPerronhöhen.Height = 392
If intZeile1 = 14 Then usrPerronhöhen.Height = 417
If intZeile1 = 15 Then usrPerronhöhen.Height = 441
If intZeile1 = 16 Then usrPerronhöhen.Height = 465
If intZeile1 = 17 Then usrPerronhöhen.Height = 489
If intZeile1 = 18 Then usrPerronhöhen.Height = 513
' .Repaint
'End With
End Sub
Gregor