Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Const dFixedPos As Double = "0.8"
Const dFixWidth As Double = "12.0" 'Change here to change WIDTH of the DropDown
Dim vld As Validation
Dim lDpdLine As Long
If Not prvTarget Is Nothing Then
If Not oDpd Is Nothing Then
If oDpd.Value = 0 Then
prvTarget.Value = vbNullString
Else
prvTarget.Value = Range(Mid(sFml1, 2)).Item(oDpd.Value)
End If
Set prvTarget = Nothing
End If
End If
On Error Resume Next
oDpd.Delete
sFml1 = vbNullString
Set oDpd = Nothing
On Error GoTo 0
If Target.Count > 1 Then
Set oDpd = Nothing
Exit Sub
End If
Set vld = Target.Validation
On Error GoTo Terminate
sFml1 = vld.Formula1
On Error GoTo 0
Set prvTarget = Target
lDpdLine = Range(Mid(sFml1, 2)).Rows.Count
With Target
Set oDpd = ActiveSheet.DropDowns.Add( _
.Left - dFixedPos, _
.Top - dFixedPos, _
.Width + dFixWidth + dFixedPos * 2, _
.Height + dFixedPos * 2)
End With
With oDpd
.ListFillRange = sFml1
.DropDownLines = lDpdLine
.Display3DShading = True
End With
Terminate:
End Sub
Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden
Suche nach den besten AntwortenEntdecke unsere meistgeklickten Beiträge in der Google Suche
Top 100 Threads jetzt ansehen