ארכיון תגיות: Windows API

לפתוח מסך של Access בלי להציג את הרקע של Access Application – באמצעות Windows API

הערה : לא מתאים למתכנתים מתחילים.
מצריך ידע טוב ב-VBA, כולל קומפליציה מותנית, ו-Windows API.
הערה חשובה 2 : כדי לפתוח את אקסס בלי להפעיל את מה שאמור להיות מופעל בהתחלה, פותחים אותו ומחזיקים את ה- Shift לחוץ (אלא אם כן מנעתם את זה עם סקריפט ואז אתם בבעיה).

נניח ורוצים לפתוח עם VBA
את אקסס מתוך אקסל

בצורה "נקיה"
בלי להציג את מסך הרקע של אקסס.

הפתרון שלי מבוסס על הפתרון של KNK שמופיע כאן.
והוא ביסס את הפתרון על פתרון של Dev Ashish/
ואני שיכללתי את זה טיפ טיפ.

היתרון בפתרון שלי הוא שהוא … כתוב בעברית 🙂
וגם כן תפרתי היטב את החלקים שקשורים ל-VBA7 ול-Win 64

אז ככה :
1. באפליקציה האקסס אתה חייב :
1.1 להגדיר טופס שעולה עם התחלת התוכנה
1.2 לבטל את "חלונית הניווט"
1.3 לבטל את "הצג לשוניות מסמך"

שים לב,
הטופס שעולה בהתחלה יכול להכיל לוגו , וכדומה…
אבל הוא לא יכול להיות הטופס העיקרי שאליו אתה מכוון
כי הוא משמש רק למעבר…

בטופס הזה, תגדיר טיימר , נניח של 1000 מיליסקנד
ותוסיף 2 אירועים
באירוע של OnLoad אתה מסתיר את הריבון

DoCmd.ShowToolbar "Ribbon", acToolbarNo

ובאירוע של הטיימר ,
אתה עושה 3 דברים בסדר הבא :
1. קורא ל-Windows API כדי שיסתיר את החלון של האקסס
2. סוגר את הטופס הנוכחי
3. פותח את הטופס העיקרי שלך.

בנוסף חשוב לציין
כל הטפסים, הדוחות וכו', חייבים להיות
1. מודאלים
2. מוקפצים

הדוחות – חשוב לפתוח ב-Maximaize
וחשוב להגדיר כפתור בטופס הראשי שלך עם אפשרות יציאה Application.quit

אחרי כל זה
המודול שמטפל בהסתרה מכיל את הקוד הבא :

Option Compare Database
Option Explicit
'I copy from here
'http://www3.telus.net/geo123/HideAccessShell2K7.html
'http://www.utteraccess.com/forum/Forms-Access-Background-t1958468.html

Global Const SW_HIDE = 0
Global Const SW_SHOWNORMAL = 1
Global Const SW_SHOWMINIMIZED = 2
Global Const SW_SHOWMAXIMIZED = 3

#If Win64 Then
    Private Declare PtrSafe Function apiShowWindow Lib "user32" Alias "ShowWindow" (ByVal hWnd As LongPtr, ByVal nCmdShow As LongPtr) As LongPtr
#Else
    Private Declare Function apiShowWindow Lib "user32" Alias "ShowWindow" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
#End If
    

Function DoAccessWindow(nCmdShow As Long)
' This function can minimize Access behind the scenes.

'Usage Examples
'Maximize window:
'       ?DoAccessWindow(SW_SHOWMAXIMIZED)
'Minimize window:
'       ?DoAccessWindow(SW_SHOWMINIMIZED)
'Hide window:
'       ?DoAccessWindow(SW_HIDE)
'Normal window:
'       ?DoAccessWindow(SW_SHOWNORMAL)
'

Dim loX  As LongPtr
Dim loform As Form
    On Error Resume Next
    Set loform = Screen.ActiveForm
    If Err <> 0 Then 'no Activeform
      If nCmdShow = SW_HIDE Then
        MsgBox "Cannot hide Access unless a form is on screen"
      Else
        loX = apiShowWindow(hWndAccessApp, nCmdShow)
        Err.Clear
      End If
    Else
        If nCmdShow = SW_SHOWMINIMIZED And loform.Modal = True Then
            MsgBox "Cannot minimize Access with " & (loform.Caption + " ") & "form on screen"
        ElseIf nCmdShow = SW_HIDE And loform.PopUp <> True Then
            MsgBox "Cannot hide Access with " & (loform.Caption + " ") & "form on screen"
        Else
            loX = apiShowWindow(hWndAccessApp, nCmdShow)
        End If
    End If
    DoAccessWindow = (loX <> 0)
End Function



ואם הגדרת הכל נכון
אתה כבר יכול לשמור, לסגור, ולהפעיל את הקובץ אקסס, ולראות שכבר זה מסתיר את הרקע של אקסס.

עכשיו לחלק המעניין.
בפתרון של KNK מופיע גם מודול של Shell שמאפשר להשתמש ב-Windows API כדי להפעיל עוד מופעים (Instances ) של Access .
אני לקחתי את זה חצי צעד קדימה ומתוך אקסל , פתחתי כבר את האוביקט אקסס
ביררתי מה מספר החלון שלו מבחינת Windows API
ועם המספר הזה, השתמשתי במודול Shell של Windows API

בבקשה ה-VBA, מתוך אקסל , מכילה פרוצדורה אחת ופונקציה אחת
את הפונקציה מבחינת סדר הייתי ממליץ לאחסן במודול נפרד.

First Sub

sub FirstSub()
Dim acs As Object, myHWD As LongPtr, yReply As LongPtr
Set acs = CreateObject("Access.Application")
acs.Application.Visible = True
myHWD = acs.Application.hWndAccessApp
yReply = fHandleFile("C:YourDB.accdb", WIN_NORMAL, myHWD)
End Sub

Seconed Function

Option Explicit

'************ Code Start **********
'This code was originally written by Dev Ashish.
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
'Code Courtesy of
'Dev Ashish
#If VBA7 Then
Private Declare PtrSafe Function apiShellExecute Lib "shell32.dll" _
    Alias "ShellExecuteA" _
    (ByVal hWnd As LongPtr, _
    ByVal lpOperation As String, _
    ByVal lpFile As String, _
    ByVal lpParameters As String, _
    ByVal lpDirectory As String, _
    ByVal nShowCmd As LongPtr) _
    As LongPtr


#Else
Private Declare Function apiShellExecute Lib "shell32.dll" _
    Alias "ShellExecuteA" _
    (ByVal hWnd As Long, _
    ByVal lpOperation As String, _
    ByVal lpFile As String, _
    ByVal lpParameters As String, _
    ByVal lpDirectory As String, _
    ByVal nShowCmd As Long) _
    As Long
#End If
'***App Window Constants***
Public Const WIN_NORMAL = 1         'Open Normal
Public Const WIN_MAX = 2            'Open Maximized
Public Const WIN_MIN = 3            'Open Minimized

'***Error Codes***
Private Const ERROR_SUCCESS = 32&
Private Const ERROR_NO_ASSOC = 31&
Private Const ERROR_OUT_OF_MEM = 0&
Private Const ERROR_FILE_NOT_FOUND = 2&
Private Const ERROR_PATH_NOT_FOUND = 3&
Private Const ERROR_BAD_FORMAT = 11&

'***************Usage Examples***********************
'Open a folder:     ?fHandleFile("C:TEMP",WIN_NORMAL)
'Call Email app:    ?fHandleFile("mailto:dash10@hotmail.com",WIN_NORMAL)
'Open URL:          ?fHandleFile("http://home.att.net/~dashish", WIN_NORMAL)
'Handle Unknown extensions (call Open With Dialog):
'                   ?fHandleFile("C:TEMPTestThis",Win_Normal)
'Start Access instance:
'                   ?fHandleFile("I:mdbsCodeNStuff.mdb", Win_NORMAL)
'****************************************************

Function fHandleFile(stFile As String, lShowHow As Long, hWndAccessApp As LongPtr)
Dim lRet As LongPtr, varTaskID As Variant
Dim stRet As String
    'First try ShellExecute
    lRet = apiShellExecute(hWndAccessApp, vbNullString, _
            stFile, vbNullString, vbNullString, lShowHow)
            
    If lRet > ERROR_SUCCESS Then
        stRet = vbNullString
        lRet = -1
    Else
        Select Case lRet
            Case ERROR_NO_ASSOC:
                'Try the OpenWith dialog
                varTaskID = Shell("rundll32.exe shell32.dll,OpenAs_RunDLL " _
                        & stFile, WIN_NORMAL)
                lRet = (varTaskID <> 0)
            Case ERROR_OUT_OF_MEM:
                stRet = "Error: Out of Memory/Resources. Couldn't Execute!"
            Case ERROR_FILE_NOT_FOUND:
                stRet = "Error: File not found.  Couldn't Execute!"
            Case ERROR_PATH_NOT_FOUND:
                stRet = "Error: Path not found. Couldn't Execute!"
            Case ERROR_BAD_FORMAT:
                stRet = "Error:  Bad File Format. Couldn't Execute!"
            Case Else:
        End Select
    End If
    fHandleFile = lRet & _
                IIf(stRet = "", vbNullString, ", " & stRet)
End Function
'************ Code End **********