Mefisto...diabeł czy anioł?
Poni¿ej przedstawiam makro dotycz±ce - listy wielokrotnego wyboru.
Sposób dzia³ania makra - w kolumnie I pokazuje siê lista wielokretnego wyboru, z której mo¿na wybraæ kilka nazw, a po klikniêciu obok te nazwy pojawiaj± siê w danej komórce.
Mój problem, chcia³bym dodaæ do tego makra funkcjê, aby nie da³o siê wpisaæ rêcznie innej nazwy.W obecnej formie mo¿na wpisaæ inn± nazwê.
Oto kod makra:
Option Explicit
Dim kom As Range
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim a As Integer, tekst As String
If Target.Cells.Count <> 1 Then Exit Sub
If Not Intersect(Target, Range("I5:I2000")) Is Nothing Then
ListBox1.Top = Target.Top
ListBox1.Left = Target.Left
ListBox1.Visible = True
Set kom = ActiveCell
Exit Sub
End If
If ListBox1.Visible = True Then
With ListBox1
For a = 1 To ListBox1.ListCount
If .Selected(a - 1) = True Then tekst = tekst & " " & .List(a - 1): .Selected(a - 1) = False
Next a
End With
If tekst <> "" Then kom = Trim(tekst)
ListBox1.Visible = False
End If
End Sub
PROSZÊ O POMOC
[ Dodano: 2009-05-25, 21:40 ]
zanotowane.pl doc.pisz.pl pdf.pisz.pl katkaras.opx.pl
Sposób dzia³ania makra - w kolumnie I pokazuje siê lista wielokretnego wyboru, z której mo¿na wybraæ kilka nazw, a po klikniêciu obok te nazwy pojawiaj± siê w danej komórce.
Mój problem, chcia³bym dodaæ do tego makra funkcjê, aby nie da³o siê wpisaæ rêcznie innej nazwy.W obecnej formie mo¿na wpisaæ inn± nazwê.
Oto kod makra:
Option Explicit
Dim kom As Range
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim a As Integer, tekst As String
If Target.Cells.Count <> 1 Then Exit Sub
If Not Intersect(Target, Range("I5:I2000")) Is Nothing Then
ListBox1.Top = Target.Top
ListBox1.Left = Target.Left
ListBox1.Visible = True
Set kom = ActiveCell
Exit Sub
End If
If ListBox1.Visible = True Then
With ListBox1
For a = 1 To ListBox1.ListCount
If .Selected(a - 1) = True Then tekst = tekst & " " & .List(a - 1): .Selected(a - 1) = False
Next a
End With
If tekst <> "" Then kom = Trim(tekst)
ListBox1.Visible = False
End If
End Sub
PROSZÊ O POMOC
[ Dodano: 2009-05-25, 21:40 ]