Mehrspaltige Combo- bzw. Listbox

[Javeman]

Moin Community,

ich habe ein kleines Problem mit dem Code unten. Auf einer Userform habe ich eine zweispaltige Combobox die mir das Datum anzeigt und dahinter dann den Status (d.h. ob das Datum modifiziert wurde oder nicht). Außerdem habe ich eine zweispaltige Listbox, welche mir Werte aus einer anderen Tabelle anzeigen soll und in einer zweiten Spalte dann, ob eine Menge und eine Produktgruppe zugeordnet wurden.
Nun habe ich den Code entwickelt, welcher auch einwandfrei in Excel 2007 funktioniert...sobald ich das Programm dann aber auf Excel 2010 laufen lasse zeigt mir weder die Combobox noch die Listbox Werte an...beide sind einfach leer. Wenn ich Änderungen vollziehe werden mir diese in der ersten Spalte der Tabelle angezeigt...
Ich habe bereits mit den Indizes herumgespielt und von 0 auf 1 bzw. 1 auf 2 gesetzt. Leider bringt das auch keine Änderung....habt ihr eine Idee?

Code:

Option Explicit

' A instance of userform resizing class
Dim moResizer As New clsResizeUserforms

Private Sub UserForm_Initialize()
    'ini_tab_Product_Schedule
    Dim index, index2, index3, index4
    Dim intZeile As Integer
    Dim tmp, datediff
    
    'read in dates
    cboProductSchSelectDate.ColumnWidths = ("2,5cm;2cm")
    datediff = CDate(Sheet13.txtEDI.Value) - CDate(Sheet13.txtSDI.Value)
    For index = 0 To datediff
        With cboProductSchSelectDate
            .AddItem
            .List(index, 0) = Format(CDate(Sheet13.txtSDI.Value) + index, "dd/mm/yyyy")
            .List(index, 1) = ""
        End With
    Next index

    'not saved
    If tab_Product_Schedule_saved = False Then
        'init of array all 0
        For index = 0 To UBound(data_productSchedule, 1)
            For index2 = 0 To UBound(data_productSchedule, 2)
                data_productSchedule(index, index2) = 0
            Next index2
        Next index
        
        'fill array with data from input table
        index = 0
        While Sheet4.Cells(5 + index, "D").Value <> ""
            'determine corresponding listindex of date
            index3 = 0
            For index2 = 0 To cboProductSchSelectDate.ListCount - 1
                If cboProductSchSelectDate.List(index2) = Format(Sheet4.Cells(5 + index, "D").Value, "dd/mm/yyyy") Then
                    While data_productSchedule(index2 * 3, index3) <> 0
                        index3 = index3 + 1
                    Wend
                    data_productSchedule(index2 * 3, index3) = Sheet4.Cells(5 + index, "F").Value
                    data_productSchedule(index2 * 3 + 1, index3) = Sheet4.Cells(5 + index, "G").Value
                Exit For
                End If
            Next index2
            index = index + 1
        Wend
    
    'saved
    Else
        
        'fill array with data from output table
        index = 0
        index3 = 0
        While Sheet9.Cells(2 + index, "C").Value <> ""
            For index2 = 3 To 25
                data_productSchedule(index3, index2 - 3) = Sheet9.Cells(index + 2, index2).Value
                data_productSchedule(index3 + 1, index2 - 3) = Sheet9.Cells(index + 2 + 1, index2).Value
                data_productSchedule(index3 + 2, index2 - 3) = 0
            Next index2
            index = index + 2
            index3 = index3 + 3
        Wend
        
        'replace IDs with name of product groups in array
        'determine number of product groups
        index4 = 0
        While Sheet4.Cells(5 + index4, "EL").Value <> ""
            index4 = index4 + 1
        Wend
    
        For index = 0 To UBound(data_productSchedule, 1) Step 3
            For index2 = 0 To UBound(data_productSchedule, 2)
                For index3 = 0 To index4 - 1
                    If data_productSchedule(index, index2) = Sheet4.Cells(index3 + 5, "EK").Value Then
                        data_productSchedule(index, index2) = Sheet4.Cells(index3 + 5, "EL").Value
                    End If
                Next index3
            Next index2
        Next index
    End If

    Me.lstProductSchSequence.Clear
    With Me.lstProductSchSequence
        .ColumnCount = 2
        .ColumnWidths = "0,7cm;0,8cm"
        .ColumnHeads = False
    End With
    
    'read in order sequences
    index = 0
    While Sheet4.Cells(5 + index, "B").Value <> ""
        Me.lstProductSchSequence.AddItem (Sheet4.Cells(5 + index, "B").Value)
        index = index + 1
    Wend
    
    Me.lstProductSchSequence.ListIndex = 0
    Me.lstProductSchSequence.Enabled = False
    
    'read in product groups
    index = 0
    While Sheet4.Cells(5 + index, "EL").Value <> ""
        Me.lstProductSchProductGroup.AddItem (Sheet4.Cells(5 + index, "EL").Value)
        index = index + 1
    Wend
    
    Me.lstProductSchProductGroup.ListIndex = -1
    'search corresponding product group if value in array <> 0
    If data_productSchedule(0, 0) <> 0 Then
        For index = 0 To Me.lstProductSchProductGroup.ListCount - 1
            'determine corresponding listindex of product group
            If Me.lstProductSchProductGroup.List(index) = Sheet4.Cells(5, "F").Value Then
                Me.lstProductSchProductGroup.ListIndex = index
            Exit For
            End If
        Next index
    End If
    
    'set textbox quantity
    txtProductSchQuantity.Value = data_productSchedule(1, 0)
    
    'set combobox date
    cboProductSchSelectDate.ListIndex = 0
    
    cmdProductSchProductGroupDeleteSelection.Visible = False
End Sub

'When activated, instantiate the resizer and let it set the form to be resizable
Private Sub UserForm_Activate()
    Set moResizer.form = Me
    
    With Me
        'This will create a vertical scrollbar
        .ScrollBars = fmScrollBarsBoth
        
        'Change the values of 2 as Per your requirements
        .ScrollHeight = .Height - 45
        .ScrollWidth = .Width - 35
    End With
End Sub

'Let the resizer resize the form's controls
Private Sub UserForm_Resize()
    moResizer.FormResize
End Sub

Sub userform_QueryClose(Cancel As Integer, CloseMode As Integer)
    'Disable red cross
    If CloseMode = 0 Then Cancel = 1
End Sub

Private Sub txtProductSchQuantity_AfterUpdate()
    spnProductSchQuantity.Enabled = True
End Sub

Private Sub txtProductSchQuantity_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    spnProductSchQuantity.Enabled = False
    Select Case KeyAscii
        Case 48 To 57 ' Ascii-Code für Zahlen von 0-9
        Case Else
            KeyAscii = 0
            Beep
    End Select
End Sub

Private Sub spnProductSchQuantity_SpinDown()
    If CLng(txtProductSchQuantity.Value) - 1 < 0 Then
        MsgBox "Only values >= 0 are possible. ", vbInformation, "Value out of range."
        Exit Sub
    Else
        txtProductSchQuantity.Value = CLng(txtProductSchQuantity.Value) - 1
    End If
End Sub

Private Sub spnProductSchQuantity_SpinUp()
    txtProductSchQuantity.Value = CLng(txtProductSchQuantity.Value) + 1
End Sub

Private Sub cmdProductSchProductGroupDeleteSelection_Click()
    Me.lstProductSchProductGroup.ListIndex = -1
    cmdProductSchProductGroupDeleteSelection.Visible = False
End Sub

Private Sub lstProductSchProductGroup_Click()
    'ttt
    If cboProductSchSelectDate.ListIndex > -1 And Me.lstProductSchSequence.ListIndex > -1 Then
        If data_productSchedule(cboProductSchSelectDate.ListIndex * 3, lstProductSchSequence.ListIndex) = 0 And data_productSchedule(cboProductSchSelectDate.ListIndex * 3 + 1, Me.lstProductSchSequence.ListIndex) = 0 Then cmdProductSchProductGroupDeleteSelection.Visible = True
    End If
End Sub

Private Sub cmdProductSchAssignSequence_Click()
    Dim index As Integer
    Dim modified As Boolean
    modified = False
    
    'check complete assignment
    If lstProductSchProductGroup.ListIndex > -1 And txtProductSchQuantity.Value = 0 Then
        MsgBox "Product Group without Quantity is not possible!", vbCritical + vbOKOnly, "Quantity for selected Product Group missing"
        Exit Sub
    End If
    
    If lstProductSchProductGroup.ListIndex < 0 And txtProductSchQuantity.Value <> 0 Then
        MsgBox "Quantity without selection of Product Group is not possible!", vbCritical + vbOKOnly, "Assigned Product Group for Quantity is missing"
        Exit Sub
    End If
    
    If lstProductSchProductGroup.ListIndex < 0 And txtProductSchQuantity.Value = 0 Then
        MsgBox "To assign a Order Sequence you need to set the Quantity and selection a Product Group!", vbCritical + vbOKOnly, "Assignment not possible"
        Exit Sub
    End If
    
    'store new values of quantity and product group in array and set date to modified if values changed
    If CLng(txtProductSchQuantity.Value) <> data_productSchedule(cboProductSchSelectDate.ListIndex * 3 + 1, Me.lstProductSchSequence.ListIndex) Then
        data_productSchedule(cboProductSchSelectDate.ListIndex * 3 + 1, Me.lstProductSchSequence.ListIndex) = txtProductSchQuantity.Value
        modified = True
    End If
    
    If lstProductSchProductGroup.ListIndex > -1 Then
        If lstProductSchProductGroup.List(lstProductSchProductGroup.ListIndex) <> data_productSchedule(cboProductSchSelectDate.ListIndex * 3, Me.lstProductSchSequence.ListIndex) Then
            data_productSchedule(cboProductSchSelectDate.ListIndex * 3, Me.lstProductSchSequence.ListIndex) = Me.lstProductSchProductGroup.List(Me.lstProductSchProductGroup.ListIndex)
            modified = True
        End If
    End If
    
    If modified = True Then
        cboProductSchSelectDate.List(cboProductSchSelectDate.ListIndex, 1) = "modified"
    Else
        cboProductSchSelectDate.List(cboProductSchSelectDate.ListIndex, 1) = "assigned"
    End If
    
    'update of userform
    Me.lstProductSchSequence.List(Me.lstProductSchSequence.ListIndex, 1) = "assigned"
    'store assigned information in array
    data_productSchedule(cboProductSchSelectDate.ListIndex * 3 + 2, Me.lstProductSchSequence.ListIndex) = 1
    If Me.lstProductSchSequence.ListIndex < Me.lstProductSchSequence.ListCount - 1 Then
        Me.lstProductSchSequence.ListIndex = Me.lstProductSchSequence.ListIndex + 1
        'set product group
        Me.lstProductSchProductGroup.ListIndex = -1
        'search corresponding product group if value in array <> 0
        If data_productSchedule(cboProductSchSelectDate.ListIndex * 3, Me.lstProductSchSequence.ListIndex) <> 0 Then
            For index = 0 To lstProductSchProductGroup.ListCount - 1
                'determine corresponding listindex of product group
                If lstProductSchProductGroup.List(index) = data_productSchedule(cboProductSchSelectDate.ListIndex * 3, Me.lstProductSchSequence.ListIndex) Then
                    lstProductSchProductGroup.ListIndex = index
                Exit For
                End If
            Next index
        End If
        'set quantity
        txtProductSchQuantity.Value = data_productSchedule(cboProductSchSelectDate.ListIndex * 3 + 1, Me.lstProductSchSequence.ListIndex)
        cmdProductSchProductGroupDeleteSelection.Visible = False
    Else
        Beep
    End If
End Sub

Private Sub cboProductSchSelectDate_Change()
    Dim index
    
    'update of userform
    
    'reset listbox product sequence
    Me.lstProductSchSequence.ListIndex = 0
    For index = 0 To Me.lstProductSchSequence.ListCount - 1
        Me.lstProductSchSequence.List(index, 1) = ""
    Next index
    
    'set listbox product sequence
    For index = 0 To Me.lstProductSchSequence.ListCount - 1
        If data_productSchedule(cboProductSchSelectDate.ListIndex * 3 + 2, index) = 1 Then
            Me.lstProductSchSequence.List(index, 1) = "assigned"
        Else
            Exit For
        End If
    Next index
    Me.lstProductSchSequence.ListIndex = index
    
    'set product group
    Me.lstProductSchProductGroup.ListIndex = -1
    'search corresponding product group if value in array <> 0
    If data_productSchedule(cboProductSchSelectDate.ListIndex * 3, Me.lstProductSchSequence.ListIndex) <> 0 Then
        For index = 0 To lstProductSchProductGroup.ListCount - 1
            'determine corresponding listindex of product group
            If lstProductSchProductGroup.List(index) = data_productSchedule(cboProductSchSelectDate.ListIndex * 3, Me.lstProductSchSequence.ListIndex) Then
                Me.lstProductSchProductGroup.ListIndex = index
            Exit For
            End If
        Next index
    End If
    'set quantity
    txtProductSchQuantity.Value = data_productSchedule(cboProductSchSelectDate.ListIndex * 3 + 1, Me.lstProductSchSequence.ListIndex)
End Sub

Private Sub cmdProductSchDeleteModification_Click()
    Dim index, index2, index3, index4

    If cboProductSchSelectDate.List(cboProductSchSelectDate.ListIndex, 1) <> "" Then
        If MsgBox("Do you want to delete the modifications made?", vbQuestion + vbYesNo) = vbNo Then Exit Sub
        If tab_Product_Schedule_saved = False Then
        
            'replace data in array all 0
            For index2 = 0 To UBound(data_productSchedule, 2)
                data_productSchedule(cboProductSchSelectDate.ListIndex * 3, index2) = 0
                data_productSchedule(cboProductSchSelectDate.ListIndex * 3 + 1, index2) = 0
                data_productSchedule(cboProductSchSelectDate.ListIndex * 3 + 2, index2) = 0
            Next index2
            
            'replace data in array with data from output table
            index = 0
            index2 = 0
            While Sheet4.Cells(5 + index, "D").Value <> ""
                'determine corresponding listindex of date  Format(Sheet4.Cells(5 + index, "D").Value, "dd/mm/yyyy")
                If Format(Sheet4.Cells(5 + index, "D").Value, "dd/mm/yyyy") = cboProductSchSelectDate.List(cboProductSchSelectDate.ListIndex, 0) Then
                    data_productSchedule(cboProductSchSelectDate.ListIndex * 3, index2) = Sheet4.Cells(5 + index, "F").Value
                    data_productSchedule(cboProductSchSelectDate.ListIndex * 3 + 1, index2) = Sheet4.Cells(5 + index, "G").Value
                    index2 = index2 + 1
                End If
                index = index + 1
            Wend
        Else
            'replace data in array with data from output table
            index = 0
            index2 = cboProductSchSelectDate.ListIndex
    
            For index = 3 To 25
                data_productSchedule(index2, index - 3) = Sheet9.Cells(index2 + 2, index).Value
                data_productSchedule(index2 + 1, index - 3) = Sheet9.Cells(index2 + 2 + 1, index).Value
                data_productSchedule(index2 + 2, index - 3) = 0
            Next index
    
            'replace IDs with name of product groups in array
            'determine number of product groups
            index4 = 0
            While Sheet4.Cells(5 + index4, "EL").Value <> ""
                index4 = index4 + 1
            Wend
    
            index = cboProductSchSelectDate.ListIndex
            For index2 = 0 To UBound(data_productSchedule, 2)
                For index3 = 0 To index4 - 1
                    If data_productSchedule(index, index2) = Sheet4.Cells(index3 + 5, "EK").Value Then
                        data_productSchedule(index, index2) = Sheet4.Cells(index3 + 5, "EL").Value
                    End If
                Next index3
            Next index2
        End If
        
        lstProductSchProductGroup.ListIndex = -1
        'search corresponding product group if value in array <> 0
        If data_productSchedule(0, 0) <> 0 Then
            For index = 0 To lstProductSchProductGroup.ListCount - 1
                'determine corresponding listindex of product group
                If lstProductSchProductGroup.List(index) = Sheet4.Cells(5, "F").Value Then
                    lstProductSchProductGroup.ListIndex = index
                Exit For
                End If
            Next index
        End If
        
        'set textbox quantity
        txtProductSchQuantity.Value = data_productSchedule(cboProductSchSelectDate.ListIndex * 3 + 1, 0)
        
        cboProductSchSelectDate.List(cboProductSchSelectDate.ListIndex, 1) = ""
        Me.lstProductSchSequence.ListIndex = 0
        
        For index = 0 To Me.lstProductSchSequence.ListCount - 1
            Me.lstProductSchSequence.List(index, 1) = ""
        Next index
        cmdProductSchProductGroupDeleteSelection.Visible = False
    End If
End Sub

Public Sub cmdSaveProductS_Click()
    Dim index, index2
    Dim suchArray()
    Dim ersetzArray()
    Dim k As Long
    Dim tmp
    
    tmp = MsgBox("Do you want to save the new data configuration for Product Schedule?", vbQuestion + vbYesNo, "Save data of Product Schedule")
    
    If tmp = vbYes Then
        
        'calculate simulation time in minutes
        Sheet6.Cells(12, "E").Value = (datediff("d", Sheet13.txtSDI.Value, Sheet13.txtEDI.Value) + 1) * 24 * 60
        
        tab_Product_Schedule_saved = True
        
        Sheet9.Range("C2:Y57").ClearContents
        
        'save data from array in output table
        For index = 0 To UBound(data_productSchedule, 1) / 3
            For index2 = 0 To UBound(data_productSchedule, 2)
                Sheet9.Cells(2 + index * 2, 3 + index2).Value = data_productSchedule(index * 3, index2)
                Sheet9.Cells(2 + index * 2 + 1, 3 + index2).Value = data_productSchedule(index * 3 + 1, index2)
            Next index2
        Next index
        
        'replace name of product groups in output table with IDs
        ReDim suchArray(lstProductSchProductGroup.ListCount - 1)
        ReDim ersetzArray(lstProductSchProductGroup.ListCount - 1)
        
        index = 0
        While Sheet4.Cells(5 + index, "EL").Value <> ""
            'ReDim Preserve suchArray(index)
            'ReDim Preserve ersetzArray(index)
            suchArray(index) = Sheet4.Cells(5 + index, "EL").Value
            ersetzArray(index) = Sheet4.Cells(5 + index, "EK").Value
            index = index + 1
        Wend
        
        For k = LBound(suchArray) To UBound(suchArray)
          'Call ActiveSheet.UsedRange.Replace(suchArray(k), ersetzArray(k), , , False)
          Call Sheet9.UsedRange.Replace(suchArray(k), ersetzArray(k), xlWhole, , True, False)
        Next k
    
        Erase data_productSchedule
        Unload Me
    End If
End Sub

Private Sub cmdCancelProductS_Click()
    Dim tmp
    tmp = MsgBox("Do you want to quit the userform Product Schedule?", vbQuestion + vbYesNo)
    If tmp = vbYes Then
        Erase data_productSchedule
        Unload Me
    End If
End Sub

Code strukturiert dargestellt durch Code-Tags
Ralf [Bild: smilie.php?smile_ID=1810]

[Kuwer]

Hallo,

was mir sofort auffiel, ist die Deklaration der Variable DateDiff.
DateDiff ist aber eine interne Funktion! Somit sind Probleme im wahrsten Sinne des Wortes vorprogrammiert.

Gruß Uwe