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

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

问题是用户正在输入他们连接字符串的某些方面，可能是最后一个字段，然后在没有先按enter键或导航离开的情况下按“测试连接”按钮。并实际将值写入单元格。首先调用我的“测试连接”宏（链接到按钮），将状态指示器切换为绿色（假设凭据正确），但直到按钮宏运行完毕后，才会调用工作表更改方法。结果是，尽管已成功建立数据库连接，但状态指示灯从绿色闪烁，然后返回红色

我尝试过手动将焦点从当前单元格移开。在从表单按钮调用我的“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_范围内的单元格，并且他们按下“测试连接”按钮，我希望在调用“测试连接”之前完成工作表的更改。

一种方法是默认情况下禁用“测试连接”按钮。 但无论哪种方式，您都无法绕过在之后激活的“工作表更改”，所以我不会使用它，而是使用自定义函数

更新： 在回顾了您的代码之后，我在下面加入了代码，演示了我所说的内容

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

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

注: 假设

DB_STATUS

是一个全局变量，表示是否可以测试连接。

---

另外，我注意到您将这些声明为函数，但它们似乎没有返回任何值，因此我将我的版本作为子例程编写。

未经测试，但您应该看到总体思路

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

Public LastGoodConnString作为String'在常规模块中
'工作表模块
私有子工作表_更改（ByVal目标作为范围）
如果不相交（Target，Target.Worksheet.Range（DB\u CELL\u Range））则为空
CheckConnString'检查数据库条件是否已更改
如果结束
端接头
'使用主工作表凭据连接到数据库
函数TestConnection（）
设置cnn=newadodb.Connection
'打开连接。
On错误转到ConnectError
cnn.opengetConnectionString（）
ShowDBStatus True'这还将缓存连接字符串。。。
'
退出功能
连接错误：
显示状态错误
MsgBox“无法建立连接。”
退出功能
端函数
'如果连接字符串从“已知良好”值更改，则更新数据库状态
公共子检查字符串（）
ShowDBStatus（GetConnectionString（）=LastGoodConnString）_
和最后一个字符串“”
端接头
'显示数据库连接的状态
公共子ShowDBStatus（StatusOK为布尔值）
'如果连接正常，请记住连接字符串
如果状态为OK，则LastGoodConnString=GetConnectionString（）
带图纸（“主”）范围（DB\U状态\U单元）
.值=IIf（状态OK，“已连接”、“未连接”）
.Interior.ColorIndex=IIf（状态正常，4,3）
以
端接头

答案原来是一个相当简单的布尔标志，我在成功建立数据库连接时将其设置为True，然后在下一次运行

工作表\u Change

完成后将其设置为false。此后，仅在标志为false时检查DB连接。代码如下：

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

---

您应该向我们展示一些代码，以便我们能够理解在Excel2007中的快速测试中可以做什么，当单元格处于编辑模式时，不可能单击窗体或ActiveX按钮。有其他类型的按钮吗？或者是一个不同的Excel版本？@Tim我正在使用Excel 2010和一个表单button@User-是的，我在2010年也看到了这一点：不知道这一变化还会打破什么？您的问题的一个解决方案可能是将任何成功连接的参数存储在全局变量中，然后在工作表更改触发的事件期间，检查其中是否有更改，如果有更改，则只更改状态标志单元格。@Tim我正在玩一个类似于您建议的解决方案。我的状态变量现在是全局变量，如果您查看我的

工作表\u Change

，我想我正在尝试做您所说的事情。棘手的部分似乎是区分对单元格的更改与来自更改单元格的按钮单击之间的区别。。。如果有道理的话，谢谢你的回复。我在ValidateInput（）中得到一个“424 Object required”错误，在这一行：

对于工作表.Range（DB\u CELL\u Range）中的每个rCell

此时我是VBA新手。你知道怎么了吗？我试着将rCell定义为一个对象，并给Workbench.Range一个静态单元格地址。将“DB\u cell\u Range”替换为您不希望为空的单元格范围。（假设它们都在一行中

DB_CELL_RANGE

可能变成

B3:B5

）如果您的单元格都是空格，那么我/某人可以帮助修改该代码以实现此目的。由于现有的命名范围，我只假设它们相邻。我完全按照您的建议尝试过，但我仍然得到424

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