Discussion :

[alexkickstand]

bonjour, dans la FAQ access et code VBA il y a un exemple d'application afin d'ouvrir d'une appli access une autre base Access et ouvrir un de ses formulaires.

voici le code :

dans un module :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
 
Private Declare Function apiSetForegroundWindow Lib "user32" _
            Alias "SetForegroundWindow" _
            (ByVal hwnd As Long) _
            As Long
 
Private Declare Function apiShowWindow Lib "user32" _
            Alias "ShowWindow" _
            (ByVal hwnd As Long, _
            ByVal nCmdShow As Long) _
            As Long
 
Private Const SW_MAXIMIZE = 3
Private Const SW_NORMAL = 1
 
Function fOpenRemoteForm(strMDB As String, _
                                        strForm As String, _
                                        Optional intView As Variant) _
                                        As Boolean
Dim objAccess As Access.Application
Dim lngRet As Long
 
    On Error GoTo fOpenRemoteForm_Err
 
    If IsMissing(intView) Then intView = acViewNormal
 
    If Len(Dir(strMDB)) > 0 Then
        Set objAccess = New Access.Application
        With objAccess
            lngRet = apiSetForegroundWindow(.hWndAccessApp)
            lngRet = apiShowWindow(.hWndAccessApp, SW_MAXIMIZE)
            'le premier appel à  ShowWindow semble rester sans effet
            lngRet = apiShowWindow(.hWndAccessApp, SW_MAXIMIZE)
            .OpenCurrentDatabase strMDB
            .DoCmd.OpenForm strForm, intView
            Do While Len(.CurrentDb.Name) > 0
                DoEvents
            Loop
        End With
    End If
fOpenRemoteForm_Exit:
    On Error Resume Next
    objAccess.Quit
    Set objAccess = Nothing
    Exit Function
fOpenRemoteForm_Err:
    fOpenRemoteForm = False
    Select Case err.Number
        Case 7866:
            'mdb ouverte en mode exclusif
            MsgBox "The database you specified " & vbCrLf & strMDB & _
                vbCrLf & "is currently open in exclusive mode.  " & vbCrLf _
                & vbCrLf & "Please reopen in shared mode and try again", _
                vbExclamation + vbOKOnly, "Could not open database."
        Case 2102:
            'ce formulaire n'existe pas
            MsgBox "The Form '" & strForm & _
                        "' doesn't exist in the Database " _
                        & vbCrLf & strMDB, _
                        vbExclamation + vbOKOnly, "Form not found"
        Case 7952:
            'l'utilisateur a fermer la base de données
            fOpenRemoteForm = True
        Case Else:
            MsgBox "Error#: " & err.Number & vbCrLf & err.DESCRIPTION, _
                    vbCritical + vbOKOnly, "Runtime error"
    End Select
    Resume fOpenRemoteForm_Exit
End Function

puis on appelle la fonction :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
Call fOpenRemoteForm("chemin_de_ma_base\base.mdb", "Form_a_ouvrir")

je teste donc ce script il lance bien une autre instance de ACCESS puis c'est vide et j'ai une erreur :

erreur 91 : variable objet ou avec block variable non défini

merci d'avance pour de l'aide

Alex

[Dolphy35]

Salut,

En enlevant la gestion d'erreur tu aurais pu voir d'où venait l'erreur

Sinon voici une variante du code de Morsi que j'utilise et qui fonctionne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Option Compare Database
Private Declare Function apiSetForegroundWindow Lib "user32" _
            Alias "SetForegroundWindow" _
            (ByVal hwnd As Long) _
            As Long
Private Declare Function apiShowWindow Lib "user32" _
            Alias "ShowWindow" _
            (ByVal hwnd As Long, _
            ByVal nCmdShow As Long) _
            As Long
Private Const SW_MAXIMIZE = 3
Private Const SW_NORMAL = 1
'
 
Function OpenDB(strDB As String, strForm As String)
 
    Set objAccess = New Access.Application
        With objAccess
            lngRet = apiSetForegroundWindow(.hWndAccessApp)
            lngRet = apiShowWindow(.hWndAccessApp, SW_NORMAL)
            lngRet = apiShowWindow(.hWndAccessApp, SW_MAXIMIZE)
            .OpenCurrentDatabase strDB
            .DoCmd.OpenForm strForm
        End With
End Function

Appel :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Call OpenDB("Chemin de la Bd", "Form à ouvrir")

Dolphy

[alexkickstand]

Merci dolphy pour ton aide ca fonctionnes niquel chrome !!!

merci


Alex

[Krispé]

Salut,

En enlevant la gestion d'erreur tu aurais pu voir d'où venait l'erreur

Sinon voici une variante du code de Morsi que j'utilise et qui fonctionne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Option Compare Database
Private Declare Function apiSetForegroundWindow Lib "user32" _
            Alias "SetForegroundWindow" _
            (ByVal hwnd As Long) _
            As Long
Private Declare Function apiShowWindow Lib "user32" _
            Alias "ShowWindow" _
            (ByVal hwnd As Long, _
            ByVal nCmdShow As Long) _
            As Long
Private Const SW_MAXIMIZE = 3
Private Const SW_NORMAL = 1
'
 
Function OpenDB(strDB As String, strForm As String)
 
    Set objAccess = New Access.Application
        With objAccess
            lngRet = apiSetForegroundWindow(.hWndAccessApp)
            lngRet = apiShowWindow(.hWndAccessApp, SW_NORMAL)
            lngRet = apiShowWindow(.hWndAccessApp, SW_MAXIMIZE)
            .OpenCurrentDatabase strDB
            .DoCmd.OpenForm strForm
        End With
End Function

Appel :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Call OpenDB("Chemin de la Bd", "Form à ouvrir")

Dolphy

Bonjour,
Ce bout de code m'intéresse car je veux mettre à jour une base frontale (programme) en VBA.
J'ai copié collé dans un module pour le tester.
Surprise, OpenDB bloque sur "Set objAccess = New Access.Application" !
J'ai ajouté un
Dim objAccess As Access.Application puis Dim objAccess As Object
aucun des 2 n'a résolu le pb "Cette interface n'est pas prise en charge.

J'utilise Access 2010 avec en REF :
Visual Basic For Applications
Microsoft Access 14.0 Object Library
OLE Automation
Microsoft Access 14.0 database engine Object Library

Auriez-vous une idée ?
Merci d'avance

[tee_grandbois]

bonjour,
tu es peut-être en 64 bits ?
Si c'est le cas, essaie en déclarant les API comme ceci:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
#If VBA7 Then
'Declaration 64 bits
'active et affiche la fenêtre
Declare PtrSafe Function apiShowWindow Lib "user32" Alias "ShowWindow" ( _
                 ByVal hwnd As Long, _
                 ByVal nCmdShow As Long) As Long
'affiche la fenêtre au premier plan
Declare PtrSafe Function apiSetForegroundWindow Lib "user32" Alias "SetForegroundWindow" (ByVal hwnd As LongPtr) As Long
'détermine si la fenêtre est visible
Declare PtrSafe Function IsWindowVisible Lib "user32" (ByVal hwnd As LongPtr) As Long
 
#Else
'Declaration 32 bits
'active et affiche la fenêtre
Declare Function apiShowWindow Lib "User32" Alias "ShowWindow" ( _
                 ByVal Hwnd As Long, _
                 ByVal nCmdShow As Long) As Long
'affiche la fenêtre au premier plan
Declare  Function apiSetForegroundWindow Lib "user32"  Alias "SetForegroundWindow" (ByVal hwnd As Long) As Long
'détermine si la fenêtre est visible
Declare  Function IsWindowVisible Lib "user32" (ByVal hwnd As Long) As Long
 
#End If
 
Private Const SW_MAXIMIZE = 3
Private Const SW_NORMAL = 1

Sinon avec la méthode "Ouvrir base de donnée" d'après l'exemple Microsoft, cela fonctionne aussi (même si la base appelée ne s'affiche pas toujours au premier plan)

[Krispé]

Merci Tee_grandbois.

J'avais oublié cette modif à faire pour la compatibilité 32 et 64 bits.
Je viens de vérifier, je suis en 32 bits.
J'ai quand mis ton code pour la portabilité
Le problème reste le même.

J'ai réussi à ouvrir la 2e BDD avec

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
' crée espace de travail  Access
        Set wrkAcc = CreateWorkspace("MAJ", "admin", "", dbUseJet)
        'ouvre la BDD de MAJ
        Set dbMAJ = DBEngine(0).OpenDatabase(vRepS & "\" & vFmaj, False)

Ca fonctionne aussi sans créer de Workspace. Je ne sais pas si c'est utile de le faire ?

Merci
Kris

[Krispé]

Bonjour,
Ce bout de code m'intéresse car je veux mettre à jour une base frontale (programme) en VBA.
J'ai copié collé dans un module pour le tester.
Surprise, le code bloque sur "Set objAccess = New Access.Application" !

Résolu par Set ObjAccess = Nothing juste avant Set ObjAccess = New Access.Application

C'est un contournement mais je n'ai pas compris le pourquoi

en tout cas si ça peut vous être utile ...

Kris

[tee_grandbois]

C'est un contournement mais je n'ai pas compris le pourquoi

sans doute une instance précédemment créée mais qui n'a pas été "détruite", ce que ne fait pas le code de l'exemple Microsoft, justement ...
une autre méthode, toujours en partant de l'exemple Microsoft:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Function OpenDb2(strDB As String, strForm As String)
Dim appAccess As Object
 
 ' Create new instance of Microsoft Access.
 Set appAccess = CreateObject("Access.Application")
 appAccess.Visible = True
 ' Open database in Microsoft Access window.
 appAccess.OpenCurrentDatabase strDB
 ' Open form.
 appAccess.DoCmd.OpenForm strForm
 
 Set appAccess = Nothing
End Function

mais qui a l'avantage de ne pas utiliser de références grâce à la méthode de liaison tardive

[Krispé]

Merci encore Tee grandbois.

La liaison tardive est un vrai plus.

Merci