اخفاء شاشة الاكسس والتعامل مع النماذج

[2saad]

إخواني الأعزاء بعد سلام الله عليكم ورحمة الله وبركاته 

في الملف المرفق محتاج أخفي شاشة الاكسس والتعامل مع النماذج 

 

SaadPermissionsLast-1.rarSaadPermissionsLast-1.rar

[Foksh]

استخدم خاصية البحث ، وستجد الكثير من المواضيع التي تحدثت عن نفس الموضوع . والتالي احدثها

 

 

[Debug Ace]

انشئ وحدة نمطية عامة جديدة باسم : modWindowManager
قم باضافة الكود التالى الى الوحدة النمطية العامة

Option Private Module
Option Compare Database
Option Explicit

' -----------------------------------------------------------------------
' Windows API declarations — conditional for 32-bit / 64-bit compatibility
' -----------------------------------------------------------------------
#If VBA7 Then
    Private Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hWnd As LongPtr, ByVal nCmdShow As Long) As Long
    Private Declare PtrSafe Function GetWindowLongPtr Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As LongPtr, ByVal nIndex As Long) As LongPtr
    Private Declare PtrSafe Function SetWindowLongPtr Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
#Else
    Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
    Private Declare Function GetWindowLongPtr Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
    Private Declare Function SetWindowLongPtr Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex    As Long, ByVal dwNewLong As Long) As Long
#End If

' -----------------------------------------------------------------------
' Window-style constants
' -----------------------------------------------------------------------
Private Const GWL_EXSTYLE     As Long = -20
Private Const WS_EX_APPWINDOW As Long = &H40000

' ShowWindow state constants (Public so callers may use them directly)
Public Const SW_HIDE          As Long = 0
Public Const SW_SHOWNORMAL    As Long = 1
Public Const SW_SHOWMINIMIZED As Long = 2
Public Const SW_SHOWMAXIMIZED As Long = 3
Public Const SW_SHOW          As Long = 5

' Tracks current visibility state
Private m_bAppWindowHidden    As Boolean

Public Function HideAppWindow(Optional ByVal frm As Access.Form = Nothing) As Boolean

    On Error GoTo ErrHandler

    ' -- Resolve the target form -----------------------------------------------
    Dim frmTarget As Access.Form
    Set frmTarget = IIf(frm Is Nothing, ActiveFormOrNothing(), frm)
    
    If frmTarget Is Nothing And Forms.Count > 0 Then
        ' Screen.ActiveForm غير جاهز بعد — نأخذ أول نموذج مفتوح
        Set frmTarget = Forms(0)
    End If
    
    If frmTarget Is Nothing Then
        LogError "HideAppWindow", "No open form found to promote to the taskbar."
        HideAppWindow = False
        Exit Function
    End If

    ' -- Obtain the form window handle -----------------------------------------
#If VBA7 Then
    Dim hForm As LongPtr
#Else
    Dim hForm As Long
#End If
    hForm = frmTarget.hWnd

    If hForm = 0 Then
        LogError "HideAppWindow", "Could not obtain a valid hWnd for: " & frmTarget.Name
        HideAppWindow = False
        Exit Function
    End If

    ' -- Apply WS_EX_APPWINDOW so the form appears on the taskbar --------------
#If VBA7 Then
    Dim lExStyle As LongPtr
#Else
    Dim lExStyle As Long
#End If
    lExStyle = GetWindowLongPtr(hForm, GWL_EXSTYLE)
    SetWindowLongPtr hForm, GWL_EXSTYLE, lExStyle Or WS_EX_APPWINDOW
    ' -- Hide the Access shell then bring the form forward ---------------------
    ShowWindow Application.hWndAccessApp, SW_HIDE
    ShowWindow hForm, SW_SHOW
    DoEvents
    m_bAppWindowHidden = True
    HideAppWindow = True
    Exit Function
ErrHandler:
    LogError "HideAppWindow", Err.Number & " - " & Err.Description
    HideAppWindow = False
End Function

Public Function RestoreAppWindow(Optional ByVal nCmdShow As Long = SW_SHOW) As Boolean
    On Error GoTo ErrHandler
    If Not IsValidShowCmd(nCmdShow) Then
        LogError "RestoreAppWindow", "Invalid nCmdShow value: " & nCmdShow
        RestoreAppWindow = False
        Exit Function
    End If
    RestoreAppWindow = SetAccessWindow(nCmdShow)
    If RestoreAppWindow Then m_bAppWindowHidden = False
    Exit Function
ErrHandler:
    LogError "RestoreAppWindow", Err.Number & " - " & Err.Description
    RestoreAppWindow = False
End Function

Public Property Get IsAppWindowHidden() As Boolean
    IsAppWindowHidden = m_bAppWindowHidden
End Property

Private Function SetAccessWindow(ByVal nCmdShow As Long) As Boolean
    On Error GoTo ErrHandler
    ShowWindow Application.hWndAccessApp, nCmdShow
    DoEvents
    SetAccessWindow = True
    Exit Function
ErrHandler:
    LogError "SetAccessWindow", Err.Number & " - " & Err.Description
    SetAccessWindow = False
End Function

Private Function ActiveFormOrNothing() As Access.Form
    On Error Resume Next
    Set ActiveFormOrNothing = Screen.ActiveForm
    On Error GoTo 0
End Function

Private Function IsValidShowCmd(ByVal nCmdShow As Long) As Boolean
    Select Case nCmdShow
        Case SW_HIDE, SW_SHOWNORMAL, SW_SHOWMINIMIZED, SW_SHOWMAXIMIZED, SW_SHOW
            IsValidShowCmd = True
        Case Else
            IsValidShowCmd = False
    End Select
End Function

Private Sub LogError(ByVal sSource As String, ByVal sMessage As String)
    Dim sEntry As String
    sEntry = "[" & Format(Now, "yyyy-mm-dd hh:nn:ss") & "] " & "modWindowManager." & sSource & " >> " & sMessage
    Debug.Print sEntry
End Sub

وفى نموذج البدء فى حدث تحميل النموذج
 

Private Sub Form_Load()
    HideAppWindow
End Sub

او ان اردت عمل زر أمر لاخفاء اطار الاكسس ضع به فقط الاستدعاء التالى 
 

    HideAppWindow

و ان اردت عمل زر أمر لاستعادة اطار الاكسس مرة أخرى ضع به فقط الاستدعاء التالى 
 

    RestoreAppWindow

 

[Debug Ace]

ملاحظة هامة
يجب ضبط خاصية النموذج Pop Up =Yes

[Debug Ace]

13 دقائق مضت, Debug Ace said:

ملاحظة هامة
يجب ضبط خاصية النموذج Pop Up =Yes

وطبعا لان الخاصية دى لو مش مظبوطة تمام سوف يتم اخفاء اطار اكسس ومع احفاء النموذج تمام وسف تعلق القاعدة فى البرامج المشغلة فى الخلفية ولن تستطيع اعادة فتح القاعدة الا بالاغلاق القسرى من ال/ Task Manager 

ومن اجل ذلك خطر على بالى تعديل كود الاخفاء الى الكود التالى

Public Function HideAppWindow(Optional ByVal frm As Access.Form = Nothing) As Boolean

    On Error GoTo ErrHandler

    ' -- Resolve the target form -----------------------------------------
    Dim frmTarget As Access.Form
'    Set frmTarget = IIf(frm Is Nothing, ActiveFormOrNothing(), frm)
    If frm Is Nothing Then
        Set frmTarget = ActiveFormOrNothing()
    Else
        Set frmTarget = frm
    End If

    If frmTarget Is Nothing And Forms.Count > 0 Then
        Set frmTarget = Forms(0)
    End If

    If frmTarget Is Nothing Then
        LogError "HideAppWindow", "No open form found to promote to the taskbar."
        HideAppWindow = False
        Exit Function
    End If

    ' -- [1] Checking PopUp first — completely independent of hWnd -------
    If Not frmTarget.PopUp Then
        LogError "HideAppWindow", _
            "Form '" & frmTarget.Name & "' must have PopUp = Yes " & _
            "to appear independently after hiding the Access shell."
        HideAppWindow = False
        Exit Function
    End If

    ' -- [2] Obtain hWnd after verifying the PopUp -----------------------
#If VBA7 Then
    Dim hForm As LongPtr
#Else
    Dim hForm As Long
#End If
    hForm = frmTarget.hWnd

    ' -- [3] hWnd Validation ---------------------------------------------
    If hForm = 0 Then
        LogError "HideAppWindow", _
            "Could not obtain a valid hWnd for: " & frmTarget.Name
        HideAppWindow = False
        Exit Function
    End If

    ' -- [4] Apply WS_EX_APPWINDOW  --------------------------------------
#If VBA7 Then
    Dim lExStyle As LongPtr
#Else
    Dim lExStyle As Long
#End If
    lExStyle = GetWindowLongPtr(hForm, GWL_EXSTYLE)
    SetWindowLongPtr hForm, GWL_EXSTYLE, lExStyle Or WS_EX_APPWINDOW

    ' -- [5] Hiding the shell and detecting the form ---------------------
    ShowWindow Application.hWndAccessApp, SW_HIDE
    ShowWindow hForm, SW_SHOW

    DoEvents
    m_bAppWindowHidden = True
    HideAppWindow = True
    Exit Function

ErrHandler:
    LogError "HideAppWindow", Err.Number & " - " & Err.Description
    HideAppWindow = False
End Function

 

[2saad]

شكرا أخي الكريم 

أنا طبقت الكود كما هو علي الملف تبعي 

ولكن بعد فتح النموذج تختفي قاعدة البيانات