Question

我正在开发一个电子表格工具，用于查询SQL Server数据库并使用结果填充各种工作表。我为用户提供了一个简单的GUI（格式化单元格）来输入他们的数据库凭据和一个Excel表单按钮来测试连接。当按下按钮并正确形成连接字符串时，我通过将状态指示器的颜色从红色更改为绿色来识别此情况。我已经使用Worksheet_Change函数添加了对包含凭证的单元格范围的检查，如果更改了任何单元格，则会将状态从绿色切换回红色。

问题是用户正在输入其连接字符串的某些方面，可能是最后一个字段，然后按下“测试连接”按钮而不先按Enter或导航。并实际将值写入单元格。首先调用我的“测试连接”宏（链接到按钮），将状态指示器切换为绿色（假设正确的凭据），但直到按钮宏运行后才会调用Worksheet_Change方法。结果是状态指示灯从绿色闪烁，然后在成功建立数据库连接后返回红色。

我尝试过手动将焦点从当前单元格切换出来。在从表单按钮调用我的'TestConnection'函数之前。但到目前为止还没有任何效果。

编辑：一些代码...

Private Sub Worksheet_Change(ByVal Target As Range)
    Call SetGlobals

    'Check if database criteria has changed
    If Not Intersect(Target, Target.Worksheet.Range(DB_CELL_RANGE)) Is Nothing Then
        Call UpdateDBStatus(1)
    End If

End Sub

'Connect to database using Main sheet credentials
Function TestConnection()

    'Connection vars
    Set cnn = New ADODB.Connection

    'Open the connection.
    On Error GoTo ConnectError
    cnn.Open GetConnectionString()

    'Update dependencies
    'On Error GoTo FilterError
    Call UpdateFilter("select ********", "F", "F")
    Call UpdateFilter("select *******", "E", "E")
    Call UpdateDBStatus(2)

    MsgBox "Connected successfully to '" & DBASE & "' on machine '" & SERVER & "'"
    'Cleanup
    cnn.Close
    Set cnn = Nothing

    Exit Function

ConnectError:
    Call UpdateDBStatus(1)
    MsgBox "Could not establish a connection."
    Exit Function

FilterError:
    MsgBox "Filter Update Failure."
    Exit Function

End Function

'Set the status of the database connection and mark the result
Public Function UpdateDBStatus(Status As Integer)
    If Status = 1 Then
        Sheets("Main").Range(DB_STATUS_CELL).Value = "Not Connected"
        Sheets("Main").Range(DB_STATUS_CELL).Interior.ColorIndex = 3
        DB_STATUS = False
    Else
        Sheets("Main").Range(DB_STATUS_CELL).Value = "Connected"
        Sheets("Main").Range(DB_STATUS_CELL).Interior.ColorIndex = 4
        DB_STATUS = True
    End If
End Function

基本上如果有人正在编辑DB_CELL_RANGE内部的单元格并按下“测试连接”按钮，我希望在调用'TestConnection'之前完成Worksheet_Change。

Answer 1

解决此问题的一种方法是，您可以停用“测试连接”。按钮默认情况下。但无论哪种方式，你都不会绕过那个工作表的变化＆＃39;之后被激活，所以我不使用它并使用自定义功能。

<强>更新在审核了您的代码之后，我在下面的代码中展示了我正在谈论的内容。

我重新编写了验证检查，并仅在测试开始时调用它，并循环验证范围。

我还删除了更新状态，并在整个代码中粘贴了更详细的消息。（包括有关两个错误部分的说明）

Sub TestConnection()

    Call ValidateInput

    If DB_STATUS Then
        'Connection vars
        Set cnn = New ADODB.Connection

        'Open the connection.
        On Error GoTo ConnectError 
'-Have ConnectError set the DB-STATUS_Cell to 'Error' and dbstatus to False, cell to red, ect.
        cnn.Open GetConnectionString()

        'Update dependencies
        'On Error GoTo FilterError 
'-Have FilterError set the DB-STATUS_Cell to 'Error' and dbstatus to False, cell to red, ect.
        Call UpdateFilter("select ********", "F", "F")
        Call UpdateFilter("select *******", "E", "E")

        Sheets("Main").Range(DB_STATUS_CELL).Value = "Connected"


        MsgBox "Connected successfully to '" & DBASE & "' on machine '" & SERVER & "'"
        'Cleanup
        cnn.Close
        Set cnn = Nothing
    Else
        MsgBox "Please be sure that you populate all fields", vbExclamation

Exit Sub

Public Sub ValidateInput()
    Dim rCell As Range

    'assuming the named range 'DB_CELL_RANGE' contains all of the input cells you want populated
    For Each rCell In Worksheet.Range(DB_CELL_RANGE)
        If rCell.Value = "" Then
            Sheets("Main").Range(DB_STATUS_CELL).Value = "Not Connected"
            Sheets("Main").Range(DB_STATUS_CELL).Interior.ColorIndex = 3
            DB_STATUS = False
            Exit Sub
        Else
            'keep checking range
        End If

        '- If we make it here, then all of the inputs are validated
        Sheets("Main").Range(DB_STATUS_CELL).Value = "Inputs Good, Testing Connection."
        Sheets("Main").Range(DB_STATUS_CELL).Interior.ColorIndex = 4
        DB_STATUS = True

    Next rCell

End Sub

注意：假设DB_STATUS是一个全局变量，表示是否可以测试连接。另外，我注意到你将这些声明为函数，但它们似乎没有返回任何值，因此我将我的版本编写为子例程。

Answer 2

未经测试，但你应该看到一般的想法......

Public LastGoodConnString As String  'this in a regular module

'worksheet module
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Target.Worksheet.Range(DB_CELL_RANGE)) Is Nothing Then
        CheckConnString 'Check if database criteria has changed
    End If
End Sub



'Connect to database using Main sheet credentials
Function TestConnection()

    Set cnn = New ADODB.Connection

    'Open the connection.
    On Error GoTo ConnectError
    cnn.Open GetConnectionString()
    ShowDBStatus True 'this will also cache the connection string...

    '<snipped code>

    Exit Function

ConnectError:
    ShowDBStatus False
    MsgBox "Could not establish a connection."
    Exit Function

End Function

'update DB Status if connection string is changed from a "known good" value
Public Sub CheckConnString()
    ShowDBStatus (GetConnectionString() = LastGoodConnString) _
                     And LastGoodConnString <> ""
End Sub


'Show the status of the database connection
Public Sub ShowDBStatus(StatusOK As Boolean)

    'if connected OK, remember the connection string
    If StatusOK Then LastGoodConnString = GetConnectionString()

    With Sheets("Main").Range(DB_STATUS_CELL)
        .Value = IIf(StatusOK, "Connected", "Not Connected")
        .Interior.ColorIndex = IIf(StatusOK, 4, 3)
    End With

End Sub

Answer 3

答案结果是一个相当简单的布尔标志，我在建立成功的数据库连接时设置为True，然后在Worksheet_Change 完成的下一次运行后设置为false。从那时起，只在标志为false时检查数据库连接。代码如下：

Public flag As Boolean

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not flag Then
        If Not Intersect(Target, Target.Worksheet.Range(DB_CELL_RANGE)) Is Nothing Then
            UpdateDBStatus (1)
        End If
    Else
        flag = False
    End If
End Sub

'Connect to database using Main sheet credentials
Sub TestConnection()

    'Connection vars
    Set cnn = New ADODB.Connection

    'Open the connection.
    On Error GoTo ConnectError
    cnn.Open GetConnectionString()

    'Update dependencies
    On Error GoTo FilterError
    Call UpdateFilter("select ********", "F", "F")
    Call UpdateFilter("select *******", "E", "E")
    Call UpdateDBStatus(2)

    flag = True

    MsgBox "Connected successfully to '" & DBASE & "' on machine '" & SERVER & "'"
    'Cleanup
    cnn.Close
    Set cnn = Nothing

End Sub

在宏按钮调用期间完成对单元格的更改

3 个答案: