2

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

问题是用户正在输入他们连接字符串的某些方面，可能是最后一个字段，然后在没有先按回车键或导航离开的情况下按下“测试连接”按钮。并实际将值写入单元格。首先调用我的“测试连接”宏（链接到按钮），将状态指示器切换为绿色（假设凭据正确），但直到按钮宏运行完成后才会调用 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 内的单元格并且他们按下“测试连接”按钮，我希望在调用“测试连接”之前完成 Worksheet_Change。

4

3 回答 3

1

解决此问题的一种方法是您可以默认禁用“测试连接”按钮。但是无论哪种方式，您都不会绕过之后激活的“工作表更改”，所以我只是不使用它并使用自定义功能。

更新： 查看您的代码后，我在下面包含了代码，演示了我在说什么。

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

我还删除了更新状态并将其粘贴到整个代码中，并带有更详细的消息。（包括关于两个错误部分的注释）

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是一个全局变量，表示是否可以测试连接。另外，我注意到您将这些声明为函数，但它们似乎没有返回任何值，因此我将我的版本编写为子例程。

于 2012-08-13T13:30:42.883 回答
0

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

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
于 2012-08-14T18:18:01.890 回答
0

答案原来是一个相当简单的布尔标志，当建立成功的数据库连接时我将其设置为 True ，然后在下一次运行Worksheet_Change 完成后设置为 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
于 2012-08-14T18:33:40.460 回答