AW: Copy Problem
21.01.2008 15:38:15
fcs
Hallo Markus,
das Problem beim Reset rührt daher, dass in dem Tabellenblatt noch einige Comboboxen herumschwirren, deren Höhe auf 0 gesetzt ist und die unter anderem an der ausgeblendeteten Zelle D17 positioniert sind.
Mit folgendem Makro kannst du diese löschen:
Sub DropDownsLoeschen()
Dim sh As Shape, wks As Worksheet
Set wks = Worksheets("Konfigurator_Aussenkabel")
For Each sh In wks.Shapes
If Left(sh.Name, 4) = "Drop" Then
Select Case sh.Name
Case "Drop Down 1", "Drop Down 2", "Drop Down 3", "Drop Down 4", "Dropdown 5"
Case Else
sh.Delete
End Select
End If
Next
End Sub
oder du versuchst es manuell bei aktiviertem Selektions-Modus in der Symbolleiste "Zeichnen".
Vorauswahl der Steckertypen (Singlemode, Multimode) entsprechend Kabeltyp.
Das geht, allerdings muss du da noch etliches in der Tabelle anpassen:
1. Im Blatt "Daten" muss du hinter jedem Kabeltyp in einer Spalte (z.B. M) den Basistyp des Steckers eintragen.
2. für die beiden Comboboxen (Drop Down 1 und Drop Down 2) für die Steckerauswahl muss du unter Formatieren den Zellbereich für die Werteauswahl löschen.
3. für die Combobox zur Kabeltypauswahl (Drop Down 3) muss du ein Makro zuweisen, das bei Wertänderung die Auswahllisten für die beiden Comboboxen zur Steckerauswahl aktualisert.
Sub Dropdown3_BeiÄnderung()
Dim wks As Worksheet, Bereich As Range, cbIndex As Integer, Stecker As String
Dim i As Integer
Set wks = Worksheets("Konfigurator_Aussenkabel")
cbIndex = wks.Shapes("Drop Down 3").ControlFormat.ListIndex
Set Bereich = Worksheets("Daten").Range("M52:M70") 'Bereich mit Steckertyp je Kabeltyp
Stecker = Application.WorksheetFunction.Index(Bereich, cbIndex, 1)
'Auswahlliste für Stecker A aufbereiten
Set Bereich = Worksheets("Daten").Range("D7:D14") 'Stecker A Auswahlbereich
With wks.Shapes("Drop Down 1").ControlFormat
.RemoveAllItems
.AddItem Bereich(1, 1) '-- bitte auswählen --
.AddItem Bereich(2, 1) 'kein Stecker
For i = 3 To Bereich.Rows.Count
If InStr(1, Bereich(i, 1), Stecker) > 0 Then
.AddItem Bereich(i, 1)
Else
.AddItem ""
End If
Next
.ListIndex = 1
End With
'Auswahlliste für Stecker B aufbereiten
Set Bereich = Worksheets("Daten").Range("D42:D49") 'Stecker B Auswahlbereich
With wks.Shapes("Drop Down 2").ControlFormat
.RemoveAllItems
.AddItem Bereich(1, 1) '-- bitte auswählen --
.AddItem Bereich(2, 1) 'kein Stecker
For i = 3 To Bereich.Rows.Count
If InStr(1, Bereich(i, 1), Stecker) > 0 Then
.AddItem Bereich(i, 1)
Else
.AddItem ""
End If
Next
.ListIndex = 1
End With
End Sub
In der angehängten Datei hab ich dies mal so umgesetzt.
Es ist aber nicht ganz ideal gelöst, da dann, wenn ein Leereintrag gewählt wird.trotzdem ein Wertangezeigt wird. Um dies zu bereinigen müsste aber sehr viel verändert werden.
https://www.herber.de/bbs/user/49234.zip
Gruß
Franz