'Följande procedur infogas i den
önskade arbetsblad-modulen:
Option
Explicit
Private
Sub
Worksheet_BeforeDoubleClick(ByVal
Target
As
Range, Cancel
As
Boolean)
Dim
rnAvdelning
As
Range
Set
rnAvdelning = Me.Range("rnAvdelning")
If
Not
Intersect(Target, rnAvdelning)
Is
Nothing
Then
'Cellreferensen till den aktiva cellen skickas med anropet till
proceduren.
Call
Skapa_Cell_Lista(Target)
Cancel =
True
End
If
End
Sub
'Följande
procedurer infogas i en standardmodul:
Option
Explicit
Private
wbBok
As
Workbook
Private
wsBlad
As
Worksheet
Function
Skapa_Cell_Lista(Target
As
Range)
Dim
vaAvd
As
Variant
Dim
ddCellBox
As
DropDown
Set
wbBok = ThisWorkbook
Set
wsBlad = wbBok.Worksheets("Blad1")
vaAvd
= VBA.Array("AA",
"BB",
"CC")
'Här
skapas det temporära dataverifieringsobjektet.
With
Target
Set
ddCellBox = wsBlad.DropDowns.Add(.Left, .Top, .Width, .Height)
End
With
With
ddCellBox
.OnAction
=
"Avd_Chef"
.List = vaAvd
End
With
End
Function
Function
Avd_Chef()
Dim
vaAnsvarig
As
Variant
vaAnsvarig = VBA.Array("A.Andersson",
"B.Bertilsson",
"C.Cederroth")
Set
wbBok = ThisWorkbook
Set
wsBlad = wbBok.Worksheets("Blad1")
'Application.caller
returnerar namnet på det dataveriferingsobjekt som
'anropar proceduren.
With
wsBlad.DropDowns(Application.Caller)
.TopLeftCell.Value
= .List(.ListIndex)
'Här
tilldelas den intilliggande cellen namnet på avdelningens chef utifrån
'det
valda listalternativet i kolumn A.
.TopLeftCell.Offset(0,
1)
= vaAnsvarig(.ListIndex +
LBound(vaAnsvarig)
-
1)
.Delete
End
With
End
Function
