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 strukturiert dargestellt durch Code-Tags
Ralf [Bild: smilie.php?smile_ID=1810]
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 SubCode strukturiert dargestellt durch Code-Tags
Ralf [Bild: smilie.php?smile_ID=1810]
