2й клик и можно что - то выбрать

[78952]

Как сделать так, чтобы при двойно щелчке на ячейку появилось окно в котором можно было выбрать из списка значение и это значение появилось в ячейке по которой щелкали?

Код: Выделить всё

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, Range("J12:j6500")) Is Nothing Then
        Cancel = True
        Я идиот! Убейте меня, кто-нибудь!Я идиот! Убейте меня, кто-нибудь!
    End If
End Sub


[Twister]

По закрытию окна

Код: Выделить всё

Range("A1")="Selected_value"

[$€rg]

чтобы появилось окно, в котором можно было выбрать из списка, надо сначала создать его... окно или список

в справке набери Using ActiveX Controls on Sheets

[$€rg]

Код: Выделить всё

     
Worksheets(1).OLEObjects.Add ClassType:="Forms.ListBox.1", Link:=False, _
      DisplayAsIcon:=False, Left:=40, Top:=40, _
      Width:=60, Height:=80
      Worksheets(1).OLEObjects("ListBox1").Activate
      Worksheets(1).OLEObjects("ListBox1").Object.List = Array("выбор_1", "выбор_2", "выбор_N")


[$€rg]

или вообще не париться

Код: Выделить всё

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    On Error Resume Next
    If Not Intersect(Target, Range("J12:j6500")) Is Nothing Then
       Cancel = True
        Dim i(1 To 2) As String, j As Byte
        i(1) = "выбор 1": i(2) = "выбор 2"
        j = InputBox("№ варианта" & vbTab & "значение" & Chr(13) & _
         "1" & vbTab & vbTab & i(1) & Chr(13) & _
         "2" & vbTab & vbTab & i(2), "выберите 1 или 2", "2")
        Target = i(j)
    End If
End Sub

[78952]

Я сделал по др.

Код: Выделить всё

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, Range("J12:j6500")) Is Nothing Then
             Cancel = True
        If Target = vbNullString Then
            UF1.Show
        Else
            UF2.Show
         End If
    End If
End Sub

а в форме:

Код: Выделить всё

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
ActiveCell = ListBox1.Value
Unload Me
End Sub
Private Sub UserForm_Initialize()
Dim n As Single
n = 13
Do Until Sheets("КК").Range("a" & n).Value = ""
ListBox1.AddItem Sheets("КК").Range("a" & n).Value
n = n + 1
Loop
End Sub

тоже просто и красиво