Auto-Populating Combobox с данными SQL

Question

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

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

Private Sub CB_Company_Change() 

With Application 
    .Calculation = xlManual 
    .EnableEvents = False 
    .ScreenUpdating = False 
End With 

Dim stSQL As String, sBook As String, rst As ADODB.Recordset, k As Integer, vaData As Variant 
Dim objConn As ADODB.Connection 
Dim ConnectionString As String 
ConnectionString = "Provider=sqloledb.1;data source=sql-server;Initial catalog=sql-db;Integrated Security = SSPI;" 

Set objConn = New ADODB.Connection 

sBook = CB_Book.Value 
CB_Company.Clear 

stSQL = "EXEC('SELECT Name FROM TABLE1 INNER JOIN TABLE2 ON TABLE1.ID = TABLE2.ID WHERE TABLE2.NAME = ''" & sBook & "'' ORDER BY TABLE1.NAME')" 

With objConn 
    .CursorLocation = adUseClient 
    .Open ConnectionString 
    Set rst = .Execute(stSQL) 
End With 

With rst 
    Set .ActiveConnection = Nothing 
    k = .Fields.Count 
    vaData = .GetRows 
End With 

CB_Company.List = Application.Transpose(vaData) 

objConn.Close 

Set rst = Nothing 
Set objConn = Nothing 

bClear = True 

With Application 
    .Calculation = xlAutomatic 
    .EnableEvents = True 
    .ScreenUpdating = True 
End With 

End Sub 

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

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

Option Explicit 
Public bClear As Boolean 

Private Sub CB_Book_Change() 

With Application 
    .Calculation = xlManual 
    .EnableEvents = False 
    .ScreenUpdating = False 
End With 

Dim stSQL As String, rst As ADODB.Recordset, k As Integer, vaData As Variant 
Dim objConn As ADODB.Connection 
Dim ConnectionString As String 
ConnectionString = "Provider=sqloledb.1;data source=SQL-SERVER;Initial catalog=SQL-DB;Integrated Security = SSPI;" 
Set objConn = New ADODB.Connection 

stSQL = "EXEC('SELECT NAME FROM TABLE2')" 

With objConn 
    .CursorLocation = adUseClient 
    .Open ConnectionString 
    Set rst = .Execute(stSQL) 
End With 

With rst 
    Set .ActiveConnection = Nothing 
    k = .Fields.Count 
    vaData = .GetRows 
End With 

CB_Book.List = Application.Transpose(vaData) 

objConn.Close 

Set rst = Nothing 
Set objConn = Nothing 

bClear = True 

With Application 
    .Calculation = xlAutomatic 
    .EnableEvents = True 
    .ScreenUpdating = True 
End With 

End Sub 

Answer 1

Похоже, это обработчик события, когда вы выберите значение из CB_Company, но в коде, очистите то же самое поле со списком (CB_Company.clear) и запомните его (CB_Company.List = Application.Transpose (vaData)).

Answer 2

У меня была эта точная проблема в последнее время. То, что происходит, - это метод «Изменить», часто вызываемый внутри себя при обновлении контента. Например:

CB_Company.Clear 

действительно вызовет повторный вызов всего этого метода. В какой-то момент Excel перестает обрабатывать их, оставляя пустой ящик.

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

Public updatingContent As Boolean 

Затем, в начале этой подпрограммы включают в себя:

If updatingContent Then Exit Sub 
updatingContent = True 

Это предотвратит вызовы СЦЕПЛЕНИЕ.

Последний, в конце этого обработчика, не забудьте включить:

updatingContent = False 

сбросить ваш метод.

---

Вот ваш код с этими изменениями.

Public updatingContent As Boolean 
Private Sub CB_Company_Change() 

    If updatingContent Then Exit Sub 
    updatingContent = True 

    With Application 
     .Calculation = xlManual 
     .EnableEvents = False 
     .ScreenUpdating = False 
    End With 

    Dim stSQL As String, sBook As String, rst As ADODB.Recordset, k As Integer, vaData As Variant 
    Dim objConn As ADODB.Connection 
    Dim ConnectionString As String 
    ConnectionString = "Provider=sqloledb.1;data source=sql-server;Initial catalog=sql-db;Integrated Security = SSPI;" 

    Set objConn = New ADODB.Connection 

    sBook = CB_Book.value 
    CB_Company.Clear 

    stSQL = "EXEC('SELECT Name FROM TABLE1 INNER JOIN TABLE2 ON TABLE1.ID = TABLE2.ID WHERE TABLE2.NAME = ''" & sBook & "'' ORDER BY TABLE1.NAME')" 

    With objConn 
     .CursorLocation = adUseClient 
     .Open ConnectionString 
     Set rst = .Execute(stSQL) 
    End With 

    With rst 
     Set .ActiveConnection = Nothing 
     k = .fields.count 
     vaData = .GetRows 
    End With 

    CB_Company.List = Application.Transpose(vaData) 

    objConn.Close 

    Set rst = Nothing 
    Set objConn = Nothing 

    bClear = True 

    With Application 
     .Calculation = xlAutomatic 
     .EnableEvents = True 
     .ScreenUpdating = True 
    End With 

    updatingContent = False 
End Sub