Discussion :

[Crachover]

Bonjour,

Je cherche et je n'y arrive pas, plus... j'aimerais pouvoir via un bouton (formulaire) d'une base de données BD1 :

1. lancer un base de données BD2
2. fermer la base de données BD1
3. et option... la BD2 en plein écran...

Voici mes tests... ce qui est dingue, c'est que j'ai deux anciennes base de données et le Test 1 fonctionne... et quand je reprends ces lignes sur d'autres base de données cela ne fonctionne plus... ???

Soit :

• la base de données BD2 semble s'ouvrir et puis se ferme
• rien ne se passe...
• message d'erreur avec le test 4...

Test 1

Code :

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

1
2
3
4
5
6
7
8
9
     Dim objAccess As Object
 
     Set objAccess = New Access.Application
        With objAccess
            .OpenCurrentDatabase (Application.CurrentProject.Path & "\Fichier II.accdb")
        End With
        ' fermer la base de départ
        DoCmd.Maximize
         DoCmd.Quit

Test 2

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
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
 
...
 
             Set objAccess = New Access.Application
        With objAccess
            'lngRet = apiSetForegroundWindow(.hWndAccessApp)
            lngRet = apiShowWindow(.hWndAccessApp, SW_NORMAL)
            lngRet = apiShowWindow(.hWndAccessApp, SW_MAXIMIZE)
            .OpenCurrentDatabase (Application.CurrentProject.Path & "\Fichier II.accdb"")
            '.DoCmd.OpenForm "Formulaire1"
        End With
 
   DoCmd.Quit

Test 3

Code :

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

1
2
Call Shell(Application.CurrentProject.Path & "\Fichier II.accdb", 1)
Application.CloseCurrentDatabase

Test 4

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
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 fermé 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
 
 
 
...
 
 
Call fOpenRemoteForm(Application.CurrentProject.Path & "\Fichier II.accdb", "")
DoCmd.Quit

BONUS
Par contre, pour ceux qui voudrait lancer un fichier *.bat le code suivant fonctionne nickel...

Code :

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

1
2
Call Shell(Application.CurrentProject.Path & "\Fichier II.bat", 1)
Application.CloseCurrentDatabase

[nico84]

Bonjour,

J'utilise shell et ça a toujours marché :

Code :

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

1
2
3
4
5
6
7
8
'Déclaration à mettre dans un module
Public Declare Function ShellExecute 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
 
...
ShellExecute 0&, vbNullString, "C:\...\monsoft2.accdb", vbNullString, vbNullString, vbNormalFocus  'ouvre le 2e soft
DoCmd.Quit  'ferme le 1er soft
...

[micniv]

Peut être ce code pourrait méliorer votre cas. Il marche chezmoi (objet Application. au lieu de Docmd)

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
' ouvrir une nouvelle base COURANTE
Private Sub cmd_openDb1_Click()
    Dim appAccess As Object

    Set appAccess = New Access.Application
    With appAccess
        .OpenCurrentDatabase (Application.CurrentProject.Path & "\app Gestion TEST2.accdb")
        ' Window agrandie à la taille maximale
        .RunCommand acCmdAppMaximize
    End With
    ' fermer la base de départ
    Application.Quit

End Sub

[Crachover]

YES, celui-ci fonctionne chez moi...

Code :

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

1
2
3
4
5
6
7
'Déclaration à mettre dans un module
Public Declare Function ShellExecute 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
 
...
ShellExecute 0&, vbNullString, "C:\...\monsoft2.accdb", vbNullString, vbNullString, vbNormalFocus  'ouvre le 2e soft
DoCmd.Quit  'ferme le 1er soft

Ps : je ne comprends pas pour les autres... soit cela ouvre et ferme le fichier, soit ré ouvre le même fichier... et pourtant j'ai un ficher qui fonctionne avec le code suivant, pourquoi... ?

Code :

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

1
2
3
4
5
6
7
8
9
Dim objAccess As Object
 
     Set objAccess = New Access.Application
        With objAccess
            .OpenCurrentDatabase (Application.CurrentProject.Path & "\Fichier II.accdb")
        End With
        ' fermer la base de départ
        DoCmd.Maximize
         DoCmd.Quit

Merci

[electrosat03]

Salut,

Le code de micniv fonctionne parfaitement chez moi.

A+

[electrosat03]

Salut,

Bon, je reviens avec un problème pour l'ouverture de la seconde Base
En fait la seconde base reste en clognotement dans la barre des Tâches
Rien n'y fait pour avoir la seconde base en plein écran
SAUF si je vais dans le code puis je reviens dans la première base et je clic sur le bouton pour ouvrir la seconde base, là ça fonctionne.

Je n'y comprend plus rien.

J'avais le même problème avec Word et j'avais eu la réponse ici même

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Dim WordApp As Word.Application
    Dim WordDoc As Word.Document
 
    Set WordApp = CreateObject("Word.Application")
    WordApp.Visible = True 'Rend visible l'appli Word
    Set WordDoc = WordApp.Documents.Open("M:\xxx.docx") 'Ouvre le doc dans Word
    WordApp.Activate 'Active l'application
    WordApp.WindowState = wdWindowStateNormal 'Met Word en mode normal (pas en plein écran)
    AppActivate "word", 1
 
    Set WordApp = Nothing
    Set WordDoc = Nothing

Merci pour votre aide