Private Sub Daten_listen()
Dim SuBe As String
SuBe = UFoX.TeBoSuBe.Value
With UFoX
.LiBoAfill(S, SuBe, SuTec, VisOpt, WS).LiBoA
End With
End Sub
Leider reklamiert VBA, dass die Argumente mit ByRef nicht verträglich seien. Die Variablen sind bis auf "WS" vom Typ Byte, WS ist mit String deklariert. So weit ich weiß, ist es nicht möglich innerhalb einer Argumentenklammer 2 verschiedene Argumenttypen (ByVal und ByRef) anzuwenden. Wo ist der Fehler?
Der Vollständigkeit halber hier noch die Prozedur ...
Sub LiBoAfill(ByRef objListBox As MSForms.ListBox, S, SuBe, SuTec, VisOpt, WS)
Dim a As Integer
Dim AnalogStrg As Variant
Dim Kla As String
Dim KlaID As Integer
Dim LiBoS2 As String
Dim LiBoS3 As String
Dim LiBoS4 As String
Dim n As Integer
Dim nType As Byte
Dim RgO As Range
Dim TBS As String
Dim usedS As Byte
Dim v As Byte
Dim VOS2 As Byte
Dim VOS3 As Byte
Dim VOS4 As Byte
n = 0
nType = Len(SuBe)
VOS2 = Left(VisOpt, 1)
VOS3 = Mid(VisOpt, 2, 1)
VOS4 = Right(VisOpt, 1)
Application.ScreenUpdating = False
Windows("SamLibriDat.xlsm").Activate
Sheets(WS).Select
ActiveSheet.Range(S & "4").Select
objListBox.Clear
For a = 1 To ActiveSheet.UsedRange.Rows.Count
If Cells(ActiveCell.Row, 1) = "" Then Exit For
If WS = "Bücher" Or WS = "Schüler" Then
KlaID = Cells(ActiveCell.Row, 4)
Kla = FUKreaKla(KlaID)
End If
If WS = "Schüler" Then
If Cells(ActiveCell.Row, 1) = 1100 Then GoTo Sprung
TBS = "Buch"
usedS = ActiveCell.Column
v = FUnBücher(usedS)
If v > 1 Then TBS = "Bücher"
End If
If SuTec = 1 Then
If SuBe Left(Cells(ActiveCell.Row, S), nType) Then GoTo Sprung
End If
If SuTec = 2 Then
Set RgO = Sheets(WS).Cells(ActiveCell.Row, S).Find(SuBe, lookAt:=xlPart)
If RgO Is Nothing Then GoTo Sprung
End If
If SuTec = 3 Then
If SuBe Cells(ActiveCell.Row, S) Then GoTo Sprung
End If
LiBoS2 = Cells(ActiveCell.Row, 3) & " " & Cells(ActiveCell.Row, 2)
If VOS2 = 2 Then LiBoS2 = Cells(ActiveCell.Row, 2) & " " & Cells(ActiveCell.Row, 3)
Select Case VOS3
Case 1
LiBoS3 = "(" & Kla & ")"
Case 2
LiBoS3 = Left(Cells(ActiveCell.Row, 5), 4) & " (" & Kla & ") " & Right(Cells( _
ActiveCell.Row, 5), 8)
Case 3
LiBoS3 = Cells(ActiveCell.Row, 7) & " / " & Cells(ActiveCell.Row, 6)
Case 4
LiBoS3 = Cells(ActiveCell.Row, 4)
End Select
Select Case VOS4
Case 1
LiBoS4 = "(" & Kla & ")"
Case 2
LiBoS4 = Left(Cells(ActiveCell.Row, 5), 4) & " (" & Kla & ") " & Right(Cells( _
ActiveCell.Row, 5), 8)
Case 3
LiBoS4 = v & " " & TBS
End Select
With objListBox
.AddItem ""
.List(n, 0) = Cells(ActiveCell.Row, 1)
.List(n, 1) = LiBoS2
.List(n, 2) = LiBoS3
.List(n, 3) = LiBoS4
n = n + 1
Sprung:
ActiveCell.Offset(1, 0).Select
Next a
On Error Resume Next
objListBox.Selected(0) = True
ActiveSheet.Range("A1").Select
Sheets("Start").Select
Windows("SamLibri.xlsm").Activate
Application.ScreenUpdating = True
End Sub
Ganz schön viel gell. Sorry, aber ganz herzlichen Dank fürs durchlesen und fürs beantworten.
Liebe Grüße
Rainer.