AW: Artikeleingabe / Fehlermeldung
20.06.2010 08:05:24
fcs
Hallo Georg,
damit die Datei auch unter Excel97 und ggf. einer älteren Office/Windowsversion geöffnet werden kann muss du im Modul1 die Function "UniqueList" durch die folgende Prozedur ersetzen.
Ich hab's auf einem alten Notebook mit Excel97/Windows98SE getestet.
Wie schon geschrieben bleibt das Problem, dass unter Excel97 im Blatt Bestellliste die Auswahllisten für Farbe und Größe nicht erstellt/aktualisiert werden wenn per DropDown-Auswahl ein Artikel gewählt wird. Der Code des Tabellenblatts "Bestellung" muss wie folgt ersetzt werden, um das Problem zu umgehen.
Ich weiss nicht, ab welcher Excel-Version die Gültigkeits-DropDown-Auswahl das Worksheet-Change-Ereignis auslöst. Du muss also evtl. die "9" in der Versionsprüfung durch einen größeren Wert für eine der späteren Versionen ersetzen.
Gruß
Franz
Private Function UniqueList(Matrix As Range, Optional Sorted As Boolean = True) As Variant
'Erstellt unter Excel 2007 - Funktioniert auch unter Excel97
Dim rng As Range, varTmp() As Variant
Dim oCollection As New Collection, iIndex As Long
On Error GoTo Fehler
For Each rng In Matrix
If rng.Value "" Then oCollection.Add rng.Value, CStr(rng.Value)
ReDim Preserve varTmp(0 To iIndex)
varTmp(iIndex) = rng.Value
iIndex = iIndex + 1
NextRng:
Next
If Sorted Then QuickSort varTmp
UniqueList = varTmp
Fehler:
With Err
Select Case .Number
Case 0 ' Alles OK
Case 457 'Element mit gleichem Schlüssel in Collection bereits vorhanden
Resume NextRng
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbNewLine & .Description
End Select
End With
End Function
'Neuer Code Tabellenblatt "Bestellung" - Erstellt unter Excel 2007 und Excel 97
Option Explicit
Private Sub Worksheet_Calculate()
With Application
If Val(Left(.Version, 2)) "" Then
createColorList Cells(rng.Row, 5), rng.Text
createSizeList Cells(rng.Row, 6), rng.Text
Else
Range(Cells(rng.Row, 5), Cells(rng.Row, 6)).Validation.Delete
End If
Next
End If
End Sub