Возвращать текст из выпадающего списка, а не номер индекса

Question

У меня есть следующий код VBA (из MS Access 2007). Код создает новую книгу и добавляет раскрывающийся список в ячейку. Этот небольшой фрагмент добавляет выпадающий список к определенной ячейке и добавляет к ней некоторые элементы.

Dim myRng As Range
Dim myDD As Dropdown
Set myRng = wSheet.Cells(row, col)
With myRng
    Set myDD = .Parent.DropDowns.Add(Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height)
    myDD.AddItem "msg1"
    myDD.AddItem "msg2"
    myDD.LinkedCell = .Parent.Cells(row, col + 2).Address(external:=True)
End With

Все это прекрасно работает, и когда я открываю электронную таблицу, я получаю поле со списком, в котором я хочу, и элементы отображаются. Однако, когда я выбираю элемент из раскрывающегося списка в Excel, связанная ячейка показывает 1 или 2 (номер индекса). Я хотел бы показать либо msg1, либо msg2.

Возможно ли это?

Answer 1

Несколько вариантов.

Вы можете поместить раскрывающийся список проверки данных в ячейку, а не в раскрывающийся список.Это возвращает фактические результаты, а не индекс.Если вам все еще нужна отдельная связанная ячейка, вы можете поместить формулу, которая просто копирует ячейку dv

Sub MakeDv()

    Dim wSheet As Worksheet
    Dim myRng As Range

    Set wSheet = ActiveSheet

    Set myRng = wSheet.Cells(row, col)
    myRng.Validation.Add xlValidateList, , , "msg1,msg2"
    wSheet.Cells(row, col + 2).Formula = "=" & myRng.Address

End Sub

Другой вариант - не использовать свойство LinkedCell и использовать макрос для записи значения.Присвойте этому макросу выпадающий список

Sub ShowDDResult()

    Dim dd As DropDown

    Set dd = ActiveSheet.DropDowns(Application.Caller)

    ActiveSheet.Cells(row, col + 2).Value = dd.List(dd.Value)

End Sub

. Это может быть не так просто, если вы создаете лист с нуля из Access, поскольку вам нужно добавить макрос.Последний вариант - использовать свойство ListFillRange для заполнения раскрывающегося списка.Поместите список в диапазон и используйте формулу из LinkedCell, чтобы вытащить дату из списка

Sub testdd()

    Dim wSheet As Worksheet
    Dim myRng As Range
    Dim myDD As DropDown
    Dim rList As Range
    Dim aList(1 To 2, 1 To 1) As String

    Set wSheet = ActiveSheet
    Set rList = wSheet.Range("D1:D2")

    Set myRng = wSheet.Cells(row, col)
    aList(1, 1) = "msg1": aList(2, 1) = "msg2"
    rList.Value = aList

    With myRng
        Set myDD = .Parent.DropDowns.Add(Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height)
        myDD.ListFillRange = rList.Address
        myDD.LinkedCell = wSheet.Cells(row, col + 2).Address
        wSheet.Cells(row, col + 3).Formula = "=INDEX(" & rList.Address & "," & myDD.LinkedCell & ",1)"
    End With

End Sub

Answer 2

Я пытался найти более аккуратный способ сделать это, так что, возможно, этот вопрос можно было бы решить заново :) Вот как я решил эту проблему.Я создаю массив элементов, которые хочу заполнить раскрывающимся списком.Затем, используя этот массив, вы можете вернуть строку, связанную с индексом, который вы получите из выпадающего списка.

Сначала создайте функцию для возврата массива строк:

' Returns a string array of drop down items
function dditems() as string()

    Dim array(2) As String

    array(1) = "cats"
    array(2) = "dogs"

    dditems = array

end function

Затем используйте этот массивчтобы заполнить ваш выпадающий список:

' To populate your drop down
sub populatedd()

    dim dd As DropDown
    dim i As Integer 
    dim itemsArray() As String

    ' Create the dd object and item array
    set dd = Worksheets("Sheet1").DropDowns("Drop Down 1")
    set itemsArray = dditems()

    ' Loop through the array to populate the drop down
    for i = 1 to UBound(itemsArray)

        dd.AddItem (itemsArray(i))

    next i
end

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

' Get the string associated with the index
sub showDDResult()

    dim dd As DropDown
    dim itemsArray() As String

    ' Create the dd object and item array
    set dd = Worksheets("Sheet1").DropDowns("Drop Down 1")
    set itemsArray = dditems()

    ' dd.ListIndex returns index, call to array returns correct string
    MsgBox("Item selected is " & itemsArray(dd.ListIndex))
end