AW: 2 userforms untereinander. das erste oben links
27.07.2014 11:45:38
Rene
vielleicht noch zur information wie die laufbänder ausschauen.
über ein modul sieht der code wie folgt aus
Sub LaufbandStarten()
Sheets("Start").Range("N30").Value = "läuft"
Laufband2.Show 0
Laufband1.Show 0
call Laufband
End Sub
Sub Laufband()
Dim anz1 As Long, anz2 As Long
Dim i As Double, j As Double
Dim dblLabelBreite1 As Double, dblLabelBreite2 As Double
Dim t As Single
blnStop = False
dblLabelBreite1 = WorksheetFunction.Max(Laufband1.Label1.Width, 1000)
dblLabelBreite2 = WorksheetFunction.Max(Laufband2.Label1.Width, 1000)
Laufband1.Frame1.Width = WorksheetFunction.Min(dblLabelBreite1 + 2, 960)
Laufband2.Frame1.Width = WorksheetFunction.Min(dblLabelBreite2 + 2, 960)
Laufband1.Width = Laufband1.Frame1.Width + 2
Laufband2.Width = Laufband2.Frame1.Width + 2
Laufband2.Top = Laufband1.Top + Laufband1.Height + 9
'UserForm2.Left = UserForm1.Left + UserForm1.Width + 10
' ActiveCell.Select
Do Until anz2 >= 15000 And anz1 >= 15000 'Anzahl Durchläufe
If i <= 0 Then
Laufband1.Label1.Left = Laufband1.Frame1.Width
i = Laufband1.Frame1.Width + dblLabelBreite1
anz1 = anz1 + 1
End If
If j <= 0 Then
Laufband2.Label1.Left = Laufband2.Frame1.Width
j = Laufband2.Frame1.Width + dblLabelBreite2
anz2 = anz2 + 1
End If
If blnStop Then Exit Do
t = Timer
Do Until Timer > t + 0.01
DoEvents
Loop
Laufband1.Label1.Left = i - dblLabelBreite1
Laufband2.Label1.Left = j - dblLabelBreite2
i = i - 0.75
j = j - 0.9
Loop
Unload Laufband1
Unload Laufband2
End Sub
lediglich die ausrichtung oben links für das erste
sowie direkt darunter für das zweite funktioniert nicht....