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

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

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

使用SQL数据自动填充Combobox

2 个答案: