在macrosbutton调用期间完成对单元格的更改
我正在查询一个SQL Server数据库的电子表格工具，并填写结果的各种工作表。 我向用户提供了一个简单的GUI（格式化的单元格）来input他们的数据库凭证和一个Excel表单button来testing连接。 当按下button并且连接string形成正确时，我通过将状态指示器的颜色从红色更改为绿色来识别这一点。 我已经使用Worksheet_Change函数添加了一个检查单元格的范围，该单元格将会将状态从绿色切换回红色，如果任何单元格被更改。
问题是用户input连接string的某个方面，也许是最后一个字段，然后按“testing连接”button，而不必先按下input或导航。 并且实际上将值写入单元格。 我的'testing连接'macros（链接到button）首先被调用，切换状态指示器为绿色（假设正确凭据），但Worksheet_Change方法不会被调用，直到buttonmacros已经运行。 结果是状态指示灯从绿色闪烁，然后回到红色，尽pipebuild立了数据库连接成功。
我尝试过像手动切换当前单元的焦点。 在从表单button调用我的'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里面的单元格，并且他们按下'Test Connection'button，我想在调用'TestConnection'之前完成Worksheet_Change。
解决这个问题的一种方法是默认情况下可以禁用“testing连接”button。 但无论哪种方式，你不会去解决后面激活的“工作表变更”，所以我只是不使用它，并使用自定义函数。
更新：在审查你的代码后，我已经包含了下面的代码演示了我在说什么。
我重新编写了validation检查，并在testing开始时调用它，并循环遍历validation范围。
我还删除了更新状态，并通过更详细的消息将其粘贴到整个代码中。 （包括关于两个错误部分的注释）
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是一个全局variables，表示是否可以testing连接。 另外，我注意到你声明这些函数，但他们似乎没有返回任何值，所以我写我的版本为子例程。
未经testing，但你应该看到一般的想法…
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
答案原来是一个相当简单的布尔标志，我build立了一个成功的数据库连接时设置为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