---Soumis par Dev Ashish---
Ouvrir un formulaire d'une autre base de données.
(Q) Comment ouvrir les formulaires de d'autre base de données de par Automation?
(A) Access 97 nous fourni une nouvelle méthode, OpenCurrentDatabase, membre de l'objet Application. Le code qui suit utilise cette méthode pour obtenir un formulaire d'une autre base de données.
'************ Code Start ************* ' 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_NORMAL) 'le premier appel à ShowWindow semble rester sans effet lngRet = apiShowWindow(.hWndAccessApp, SW_NORMAL) .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 '************ Code End *************