首页 > 解决方案 > Excel VBA 点击问题

问题描述

我有 Excel VBA 代码,可以打开 MS Access 数据库并根据 excel 文件单元格中的单元格值进行过滤。我有一个定义的范围,但是如果我单击 excel 中的任何位置,访问将打开(请注意,如果我单击正确的单元格,则仅正确过滤)。

Option Explicit


Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Dim Init As Integer
    Dim oApp As Object
    Dim LPath As String


   'Path to Access database
    LPath = "J:\Admin\Access Database for Punch List.accdb"

     'Exit if selection is more than one cell
    If Target.Cells.Count > 1 Then
        Exit Sub
    End If

    ' Validate if selected cell is in range
    If Not Application.Intersect(Range("A23:A2000"), Range(Target.Address)) Is Nothing Then



        ' Assign studentid value from current cell
        Init = Target.Value


        ' Call the open procedure with current cell value

        Call CheckIfFileOpen

    End If
 Call OpenAccess(Init)
End Sub

Sub CheckIfFileOpen()

Dim fileName As String
Dim oApp As Object
Dim Init As Integer


fileName = "J:\Admin\Access Database for Punch List.accdb"

'Call function to check if the file is open
If IsFileOpen(fileName) = False Then



Else

    'The file is open or another error occurred
    With GetObject(, "access.application").Quit
End With

End If


End Sub

Sub OpenAccess(Init)


    Dim oApp As Object
    Dim LPath As String




    'Path to Access database
    LPath = "J:\Kyle\Access Database for Punch List.accdb"

       'Open Access and make visible
   Set oApp = CreateObject("Access.Application")
    oApp.Visible = True


   'Open Access database as defined by LPath variable

     oApp.OpenCurrentDatabase LPath
   oApp.DoCmd.OpenForm "frm_AllRecords"
   oApp.DoCmd.ApplyFilter , "Initiative_Nbr=" & Init
    oApp.Forms("frm_AllRecords").SetFocus


End Sub

结果将是仅当我单击范围内的单元格时才运行 VBA 的代码。

标签: excelvbams-access

解决方案


推荐阅读