Listbox in Cell of Excel

[byron.hopp]

Anybody had any luck with accessing Listboxes in excel using OLE. I have a spreadsheet with a Listbox in about every cell. The user is suppose to select the value from the list box to fill it out. I am trying to fill it out using Fivewin and Ole. Don't have complete access to the spreadsheet. Would like to get a cell, locate the listbox, step through the items until I find the correct one and select it and move on. I have googled this a lot but no luck so far. Thanks,

[Antonio Linares]

Dear Byron,

I have just asked chatGPT about it and it provided answer and code, you may give it a try

[byron.hopp]

I got plenty of answers from Google that didn't help. What exactly did you ask? I have no idea what the names of the list boxes are so I need to go through a process of getting a list of all of the list boxes and how to access. If it gives me the correct answer than you might never see me again on this board, but the people on this board (including yourself) have some unique knowledge, and I am not sure they have published all of it for ChatGPT to find. Please let me know what you asked and I will give it a try.

[Antonio Linares]

Dear Byron,

I copied and pasted your initial post and got some code

Code: Select all | Expand

OLEObject xlApp, xlWorkbook, xlWorksheet
...
xlApp = OLEObject.Init("Excel.Application")
xlWorkbook = xlApp.Workbooks.Open("path/to/your/spreadsheet.xlsx")
xlWorksheet = xlWorkbook.Worksheets("Sheet1")
xlWorksheet.Activate()

cellAddress = "A1"
cell = xlWorksheet.Range(cellAddress)

For Each shape In xlWorksheet.Shapes
    If shape.TopLeftCell = cell Then
        ' Handle Form Control Listbox
        ' Access the Listbox properties and methods
        Exit For
    End If
Next

For Each oleObject In xlWorksheet.OLEObjects
    If oleObject.Left = cell.Left And oleObject.Top = cell.Top Then
        ' Handle ActiveX Control Listbox
        ' Access the Listbox properties and methods
        Exit For
    End If
Next

' Interact with the Listbox, select the desired item
listbox.ListIndex = 2

xlWorkbook.Save()
xlWorkbook.Close()
xlApp.Quit()

[Antonio Linares]

Code: Select all | Expand

Sub SelectListBoxItem()
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim lb As ListBox
    Dim cell As Range
    Dim item As Variant
    Dim targetValue As String
    
    ' Assuming you have an open workbook, set the workbook and worksheet references
    Set wb = ActiveWorkbook
    Set ws = wb.Worksheets("Sheet1") ' Replace "Sheet1" with your actual sheet name
    
    ' Assuming the listbox is in cell A1 of the worksheet
    Set cell = ws.Range("A1")
    
    ' Check if the cell has a listbox
    If cell.Validation.Type = xlValidateList Then
        Set lb = cell.Validation.DropDown
        targetValue = "Your desired value"
        
        ' Loop through each item in the listbox
        For Each item In lb.List
            ' Compare the item value with the target value
            If CStr(item) = targetValue Then
                ' Select the item in the listbox
                lb.Selected(item) = True
                Exit For
            End If
        Next item
    End If
End Sub

[Antonio Linares]

Answer using Google Bard:

Code: Select all | Expand

Sub AccessListBox()

'Declare variables
Dim oExcel As Object
Dim oSheet As Object
Dim oListBox As Object
Dim i As Integer
Dim strValue As String

'Set Excel object
Set oExcel = CreateObject("Excel.Application")

'Set Excel sheet object
Set oSheet = oExcel.Sheets("Sheet1")

'Set listbox object
Set oListBox = oSheet.OLEObjects("ListBox1")

'Loop through listbox items
For i = 1 To oListBox.ListCount

'Get listbox item value
strValue = oListBox.Item(i).Caption

'If listbox item value is equal to desired value, then select it
If strValue = "Desired Value" Then
oListBox.Item(i).Selected = True
End If

Next i

'Close Excel application
oExcel.Quit

End Sub
 

[byron.hopp]

Wow, Antonio thanks for this. Btw I have been utilizing ChatGPT this morning and although I have not solved my specific question, I have learned alot. Thanks, for the Tip, and I will now go through your answers and see if I can get this.