Discussion :

[Arkham46]

On peut trouver les assistants VBA d'Access 97 ici :
http://support.microsoft.com/kb/151194/en-us
http://support.microsoft.com/kb/151218/en-us
http://support.microsoft.com/kb/151219/en-us
http://support.microsoft.com/kb/151196/en-us

- Exécutez les fichiers exe pour extraire les base de données
- Créez une nouvelle base de données et importer tous les objets d'un ou des fichiers mde/mda
(pour certains fichiers, j'ai dû ouvrir ma base en mode exclusif)

Vous pouvez voir le code VBA de vos assistants favoris
(spécifications d'import/export, création de formulaire, choix de l'image des boutons, ...)

On devrait pouvoir y trouver des choses intéressantes.
Certaines découvertes peuvent être réutilisables, d'autres pourront satisfaire notre curiosité de savoir comment sont programmés les assistants.

Postez vos découvertes à la suite de ce message.

Téléchargez la base d'exemples de code :
ftp://ftp-developpez.com/arkham46/fi...assistants.zip
Mirroir HTTP

[Arkham46]

Fenêtre de dialogue de choix de fichier/répertoire

Adapté du code vu dans les assistants.
On peut avec cette fenêtre de dialogue choisir le répertoire initial et changer la vue (détail, miniature, aperçu, ...).
On peut même changer le texte du bouton de validation.

Tester avec Access 2003 et 2007.

Dans un module standard :

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
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
 
Option Compare Database
Option Explicit
 
Private Declare Function MSAU_OfficeGetFileName Lib "msaccess.exe" Alias "#56" (gfni As WLIB_OFFICEGETFILENAMEINFO, ByVal fOpen As Integer) As Long
 
Public Enum OpenFileView
    OpenViewDetail = 0
    OpenViewPreview = 1
    OpenViewProperties = 2
    OpenViewList = 3
    OpenViewThumbNail = 4
    OpenViewIcon = 5
    OpenViewMosaic = 8
End Enum
 
Private Type WLIB_OFFICEGETFILENAMEINFO
    hwndOwner As Long
    szAppName As String * 255
    szDlgTitle As String * 255
    szOpenTitle As String * 255
    szFile As String * 4096
    szInitialDir As String * 255
    szFilter As String * 255
    nFilterIndex As Long
    lView As Long
    flags As Long
End Type
 
Private Function wlib_StFromSz(szTmp As String) As String
    Dim ich As Integer
    ich = InStr(1, szTmp, vbNullChar, vbBinaryCompare)
    If ich Then
        wlib_StFromSz = Left$(szTmp, ich - 1)
    Else
        wlib_StFromSz = szTmp
    End If
End Function
 
Private Function wlib_OfficeGetFileName(gfni As WLIB_OFFICEGETFILENAMEINFO, ByVal fOpen As Integer) As Long
    Dim lRet As Long
    gfni.szDlgTitle = RTrim$(gfni.szDlgTitle) & Chr$(0)
    gfni.szOpenTitle = RTrim$(gfni.szOpenTitle) & Chr$(0)
    gfni.szFile = RTrim$(gfni.szFile) & Chr$(0)
    gfni.szInitialDir = RTrim$(gfni.szInitialDir) & Chr$(0)
    gfni.szFilter = RTrim$(gfni.szFilter) & Chr$(0)
    lRet = MSAU_OfficeGetFileName(gfni, fOpen)
    gfni.szAppName = RTrim$(wlib_StFromSz(gfni.szAppName))
    gfni.szDlgTitle = RTrim$(wlib_StFromSz(gfni.szDlgTitle))
    gfni.szOpenTitle = RTrim$(wlib_StFromSz(gfni.szOpenTitle))
    gfni.szFile = RTrim$(wlib_StFromSz(gfni.szFile))
    gfni.szInitialDir = RTrim$(wlib_StFromSz(gfni.szInitialDir))
    gfni.szFilter = RTrim$(wlib_StFromSz(gfni.szFilter))
    wlib_OfficeGetFileName = lRet
End Function
 
Public Function GetOpenFile(Optional pTitle As String, Optional pInitialPath As String, _
                            Optional pButtonText As String, Optional pView As OpenFileView, _
                            Optional pFilter As String, Optional pFilterIndex As Long) As String
Dim lInfo As WLIB_OFFICEGETFILENAMEINFO
lInfo.szDlgTitle = pTitle
lInfo.hwndOwner = Application.hWndAccessApp
lInfo.lView = pView
lInfo.flags = &H40
lInfo.szFilter = pFilter
lInfo.nFilterIndex = pFilterIndex
lInfo.szInitialDir = pInitialPath
lInfo.szOpenTitle = pButtonText
wlib_OfficeGetFileName lInfo, True
GetOpenFile = RTrim$(lInfo.szFile)
End Function
 
Public Function GetOpenFolder(Optional pTitle As String, Optional pInitialPath As String, _
                              Optional pButtonText As String) As String
Dim lInfo As WLIB_OFFICEGETFILENAMEINFO
lInfo.szDlgTitle = pTitle
lInfo.hwndOwner = Application.hWndAccessApp
lInfo.lView = 3
lInfo.flags = &H20 Or &H4
lInfo.szInitialDir = pInitialPath
lInfo.szOpenTitle = pButtonText
wlib_OfficeGetFileName lInfo, True
GetOpenFolder = RTrim$(lInfo.szFile)
End Function

Utilisez les fonctions GetOpenFolder et GetOpenFile.

Exemple de sélection de dossier :

Code :

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

1
2
3
4
5
6
 
Function ExempleDossier()
Dim lFolder As String
lFolder = GetOpenFolder("titre", CurrentProject.Path, "Choisir ce dossier")
MsgBox lFolder
End Function

Exemple de sélection de fichiers avec miniatures

Code :

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

1
2
3
4
5
6
7
8
 
Function ExempleImageAvecMiniatures()
Dim lfile As String
lfile = GetOpenFile("Fenêtre de sélection d'images", CurrentProject.Path, "Choisir ce fichier", _
            OpenViewThumbNail, "Images " & "(*.bmp; *.jpg; *.gif)|" + "Tous les fichiers " + "(*.*)||", _
            0)
MsgBox lfile
End Function

[Arkham46]

Récupérer les images standards des boutons

Tester avec Access 2003 et 2007.

L'assistant nous propose des images à intégrer dans les boutons.

Les informations de ces images sont stockées dans une table bw_TblPictures :
- pour Access 2003 dans le fichier ACWZDAT.MDT
- pour Access 2007 dans le fichier ACWZDAT12.ACCDU

Contenu de cette table :
- Champ PictureName
Contient un identifiant de texte, à récupérer avec la fonction Application.AppLoadString.
Par exemple : Application.AppLoadString(17236084) renvoie le texte "montre".
- Champ PictureData
Contient sous forme binaire un tableau de byte à affecter à la propriété PictureData d'une image ou d'un bouton.
- Champ TBBitmapID
Contient un identifiant de bitmap à récupérer à l'aide de la fonction wlib_GetTcDIB qui se déclare comme suit :

Code :

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

Declare Function wlib_GetTcDIB Lib "msaccess.exe" Alias "#60" (ByVal idBmp As Long, ByVal fLarge As Long, rgbBuf() As Byte) As Long

En fonction des images, PictureData ou TBBitmapID est utilisé.

Voir le formulaire FormButtonImg de la base d'exemples pour un exemple d'utilisation.

[LedZeppII]

Bonsoir,

J'ai découvert quelque chose que j'ignorai : la propriété UserControl de l'objet Application pour Acces, Excel, Word.
UTILITY.MDA, module Utils, fonction util_StartMSToolbarApp.

Si on crée un objet XXXXXX.Application (où XXXXXX peut être Access, Excel ou Word)
et que l'on met ses propriétés Visible et UserControl à True, l'instance de l'application créée
reste ouverte même lorsque l'objet n'est plus référencé.
Ça peut être la cas, lorsque la variable objet référençant l'objet a une portée limitée,
comme dans cet exemple :

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
Private Sub Commande1_Click()
Dim NewApp As Access.Application
 
Set NewApp = CreateObject("Access.Application")
NewApp.OpenCurrentDatabase "C:\Chemin\bdd.mdb"
NewApp.Visible = True
 
' Empêcher la libération de l'objet créée par automation, ce qui
' en principe entraîne la fermeture de l'application, lorsque
' l'objet n'est plus référencé.
' C'est le cas à la fin de cette Sub car la variable objet NewApp
' est la seule référence.
NewApp.UserControl = True
 
Set NewApp = Nothing
End Sub

J'ai déjà vu des personnes se plaindre qu'une application ouverte par automation, se refermait aussitôt,
ou se refermait lorsqu'on fermait l'application l'ayant ouverte.
C'est ce qui se passe dans mon exemple (avec Access 2000 en tout cas) si je ne mets pas UserControl à True.

Pour les personnes ayant des soucis de "durée de vie" d'une application Office ouverte par automation,
essayez en affectant True à la propriété UserControl de l'objet Application.

Merci à Arkham46 de m'avoir permis cette découverte.
Elle va simplifier le code de certaines de mes applis où je contournai le souci évoqué plus haut.

A+

[Invité]

Bonjour

Excellent tout cela, je vois (comme vous l'avez fait) une personnalisation des assistants pour des usages particuliers.

Philippe

[Arkham46]

J'ai découvert quelque chose que j'ignorai : la propriété UserControl de l'objet Application pour Acces, Excel, Word.

Bien vu

[Arkham46]

Boîte de dialogue de choix de couleur

Tester avec Access 2003.

Vu dans wzlib_mod de WZMAIN80.

Délcaration :

Code :

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

Public Declare Sub wlib_AccChooseColor Lib "msaccess.exe" Alias "#53" (ByVal Hwnd As Long, rgb As Long)

Utilisation :

Code :

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

1
2
3
 
Dim lrgb As Long
wlib_AccChooseColor Application.hWndAccessApp, lrgb