使用 SQL 数据自动填充组合框

Question

我是这个论坛的新手，如果有人问过这个问题但我还没有找到，或者我在错误的地方发帖，我深表歉意。

我有一个多年来一直在使用的例程，它根据来自 SQL 的数据填充组合框。我有一个包含两个组合框的电子表格，第一个组合框工作正常，并直接从 SQL 表中提供文件夹名称列表。第二个组合框填充了与在第一个组合框中选择的文件夹相关联的所有合同。但是我无法让代码自动填充，为了让组合框更新，我必须先从下拉列表中选择一个项目，然后该值不被保留。我在下面粘贴了我的代码：

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

然后，在这个 sub 的开头包括：

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