Excel WinForm combobox not working right

[jkvt]

Hi,

I have a VBA script that places WinForm dropdown boxes (xlDropDown) into an excel workbook dynamically. For some reason, on the 17th box (called "INCL" & i + 1 in the code below), the data type of the placed shape becomes msoAutoShape instead of msoFormControl. All of the following controls are msoFormControl again. I've been banging my head on this one. If anyone has any ideas as to why this is happening, that would be great. The problem is that I am able to access te selection in msoFormControl, but not msoAutoShape. Thanks very much.

Sub CreateFormsButton()

Range("A1").Select


Application.StatusBar = "Adding Buttons and Defaults..."
Application.ScreenUpdating = False

Dim curCombo As Excel.Shape
Dim btn As Button
Dim rng As Range
Dim i As Integer

'Select first difference row
With Worksheets("Report")
Set rng = .Range("E2")

i = 0

Do While rng.Value <> ""

Set curCombo = ActiveSheet.Shapes.AddFormControl(xlDropDown, rng.Offset(0, 2).Left, rng.Offset(0, 2).Top, rng.Offset(0, 2).Width, rng.Offset(0, 2).Height)
 With curCombo
        .ControlFormat.DropDownLines = 10
        .ControlFormat.AddItem "RTL", 1
        .ControlFormat.AddItem "NW", 2
        .ControlFormat.AddItem "Custom 1", 3
        .ControlFormat.AddItem "Custom 2", 4
        .ControlFormat.AddItem "Custom 3", 5
        .ControlFormat.AddItem "002", 6
        .ControlFormat.AddItem "13", 7
        .ControlFormat.AddItem "1005", 8
        .ControlFormat.AddItem "001", 9
        .ControlFormat.AddItem "202", 10
        .ControlFormat.AddItem "03", 11
        .ControlFormat.AddItem "2004", 12
        .ControlFormat.AddItem "001", 13
        .ControlFormat.AddItem "402", 14
        .ControlFormat.AddItem "4004", 15
        .ControlFormat.AddItem "405", 16
        .ControlFormat.AddItem "None", 17
        .Name = "CBOA" & i + 1 '
'        .OnAction = "getCboAllocationSelection"

        .ControlFormat.ListIndex = 1
 End With


 Set curCombo = ActiveSheet.Shapes.AddFormControl(xlDropDown, rng.Offset(0, 3).Left, rng.Offset(0, 3).Top, rng.Offset(0, 3).Width, rng.Offset(0, 3).Height)
 With curCombo
        .ControlFormat.DropDownLines = 10
        .ControlFormat.AddItem "NH", 1
        .ControlFormat.AddItem "ME", 2
        .ControlFormat.AddItem "VT", 3
        .ControlFormat.AddItem "TEST", 4
        .ControlFormat.AddItem "ALL", 5
        .Name = "INCL" & i + 1
        '.OnAction = "setInclude"

        .ControlFormat.ListIndex = intDefaultAllocateTo
 End With


    'Clear
    Set btn = .Buttons.Add(rng.Offset(0, 4).Left, rng.Offset(0, 4).Top, rng.Offset(0, 4).Width, rng.Offset(0, 4).Height)
    With btn
        .Caption = "Clear"
        .OnAction = "Clear"
        .Name = "CLER" & i + 1
    End With



    'Offset 1 row
    Set rng = rng.Offset(1, 0)

    i = i + 1
Loop

    'Create new range
    Dim rng2 As Range
    Set rng2 = .Range("K4")

    'Add go button
    Set btn = .Buttons.Add(rng2.Offset(0, 0).Left, rng2.Offset(0, 0).Top, rng2.Offset(0, 0).Width, rng2.Offset(0, 0).Height * 2)
    With btn
        .Caption = "Allocate All"
        .OnAction = "Allocate"
        .Name = "Allocate"
    End With

    'Add refresh button
    Set btn = .Buttons.Add(rng2.Offset(3, 0).Left, rng2.Offset(3, 0).Top, rng2.Offset(3, 0).Width, rng2.Offset(3, 0).Height)
    With btn
        .Caption = "Refresh Data"
        .OnAction = "RefreshData"
        .Name = "Allocate"
    End With

    'Add clear all button
    Set btn = .Buttons.Add(rng2.Offset(4, 0).Left, rng2.Offset(4, 0).Top, rng2.Offset(4, 0).Width, rng2.Offset(4, 0).Height)
    With btn
        .Caption = "Clear All"
        .OnAction = "ClearAllOptions"
        .Name = "Allocate"
    End With




End With
Application.ScreenUpdating = True

'
'Set rng = .Range("H5")
'rng.Select

Application.StatusBar = ""

End Sub

[Stuugie]

Hi jkvt,

What is it you are wanting to accmplish after you make these drop downs and buttons? I cannot reproduce your issues so I'm thinking they are coming up somewhere else, perhaps in another code block?

[jkvt]

Hi Stuugie,

In a nutshell, when the user presses a button, I am hoping to get the value selected out of the drop down and use it to decide how to populate a database with a new record. It's basically a switch so if the user selects "NH" for instance, the script populates a New Hampshire database record with some other data in the Excel file. It's interesting that it worked on your end because the code in that loop does not call any other function or subroutine. Maybe I'll try to bring this code into a new Excel file and see how it works there. I've been trying to avoid that because there is some background work that would need to be done on that new Excel file first. Thanks for trying out the code.

[Stuugie]

Please keep this thread updated if you don't mind, I'd like to know if it works in a new Excel book on your end too.

What version of Excel are you using?

[jkvt]

Will do. About to give it a shot. I'm using 2010.

[jkvt]

It looks like that did it! Thanks very much for the help, Stuugie. We've had some other problems with these XLSX/XLSM files in the past (styles filling up, etc), but this was a new one.

[jkvt]

Intestingly.. this problem came back in the new file. So, I went in and deleted the dropdown that was causing the problem. Then, I renamed the xlsm file a zip and exported all of the files within it to a folder. Did a search on all of their contents for the item that was causing the problem now (CBOA35) and sure enough, even though I deleted it, CBOA35 still existed in drawing1.xml. It did not exist in sheet1.xml. All the non-deleted items appeared in both sheet1 and drawing1. It appears Excel is not removing the item properly, so my guess is this is what is causing the problem. I am also guessing this is similar to the style problem XLSX/XLSM files have, where if you have a whole bunch of styles, you delete them and make new ones, eventually Excel will tell you there are too many styles because it is not properly deleting what it should be.

[Stuugie]

So are you basically deleting them and then re-adding them according to adjacent cells, which can be dynamic? Is that where Excel is not deleting them properly?

If yes, try deleting them along these lines:

Sub DeleteShapes()

    Dim wS1 As Worksheet
    Dim shp As Shape

    Set wS1 = Worksheets("Sheet1")
    For Each shp In wS1.Shapes
        shp.Delete
    Next shp

End Sub

[jkvt]

Awesome, Stuugie. Great call. I was using:

Sheets("Report").DrawingObjects.Select
Selection.Delete

But your code avoids that issue I was running into. Thanks again for all your help.

[Stuugie]

Hmm, that's a stickler of an issue!