2

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 内のセルを編集していて、'Test Connection' ボタンを押した場合、'TestConnection' を呼び出す前に Worksheet_Change を完了させたいと考えています。

4

3 に答える 3

1

これにアプローチする 1 つの方法は、デフォルトで「接続のテスト」ボタンを無効にすることです。しかし、いずれにせよ、「ワークシートの変更」が後でアクティブ化されることを回避することはできないので、それを使用せずにカスタム関数を使用します。

更新: コードを確認した後、私が話していることを示すコードを以下に含めました。

検証チェックを書き直して、テストの開始時にのみ呼び出し、検証範囲をループします。

また、更新ステータスを削除し、より詳細なメッセージとともにコード全体に貼り付けました。(2 つのエラー セクションに関するメモを含む)

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

Worksheet_Change 回答は、データベース接続が正常に確立されたときに True に設定し、次のFinishsの実行後に 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
于 2012-08-14T18:33:40.460 に答える
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 に答える