Discussion :

[Access_ible]

Bonjour,

Je déterre un topic…

J'utilise Mapinfo 9 et Access 2000.

J'ai créé un certain nombre de fichiers MBX, qui exécutent des actions sur diverses couches de Mapinfo.

J'ai fait deux version de ces MBX. Une première avec un bouton dans la barre d'outil MI et l'autre sans bouton.

Que je clique sur le bouton, ou que j'aille dans le gestionnaire des fichiers pour cliquer sur le fichier MBX qui ne possède pas de bouton, le résultat est le même.

Je voudrait donc créer une macro qui exécute une fonction dans un module, dont le résultat serrait le même que si j'allais dans le gestionnaire des fichiers pour cliquer sur le fichier MBX sans bouton.

Cela fait deux semaines que j'ai découvert ce topic quelques lignes plus bas.
http://www.developpez.net/forums/d46...df-access-vba/
et que je tentes d'utiliser le code qui, je le suppose, fonctionne aussi pour n'importe quel autre type de fichier.

Malheureusement, même après avoir suivi les instructions, qui semblent être reprises sur plusieurs sites et forum, je n'arrive à rien.

Access stoppe et indique un problème de compilation. Il me propose de recompiler et recommencer.
Le débogueur ne s'exécute même pas, donc je n'ai pas d'idée de l'origine du problème.

Je n'ai pas non plus pu utiliser la fonction "dim Ret as Variant" puisque j'ai aussi eu le message d'erreur de compilation.

Ceci-dit, je n'ai pas une grosse expérience en VBA (ni-même une moyenne d'ailleurs, mais il parait que ce n'est pas la taille qui compte mais la façon d'ont on s'en sert … mais je m'égares…)

Ainsi, malgré les nombreux exemples que j'ai trouvé sur le net et notamment dans ce forum, je ne suis toujours pas arrivé à mes fins puisqu'il y a de fortes chances que je n'ai pas mis l'ensemble du code necessaire au bon fonctionnement .

Aussi, où pourrait-je trouver un exemple de code complet pour cette fonction, version VBA pour les plus que nuls.

D'avance merci.

PS : j'ai essayé de poster sur le topic en question, avant de me rendre compte de sa fermeture... Désolé !

[Access_ible]

Bonjour,

Personne ?

On m'a preté 4 bouquins sur VBA, mais pas un seul exemple.

Même quand je recopie un exemple d'utilisation sur le site de Microsoft, j'ai une erreur de syntaxe !

Même pas une idée…

Encore merci.

[Domi2]

Bonjour,

As-tu la possibilité de poster ta base ?

Domi2

[Access_ible]

Ben, non

Elle est plutôt volumineuse.

Mais ce que je recherche c'est un exemple de module avec le code déja saisi.

Comme ça je n'aurrais plus qu'à mettre le fichier qui m'interesse à la place du fichier exemple.

Un peu comme dans le lien que je site plus haut, suaf que je ne suis pas arrivé à le faire marcher.

J'ai aussi trouvé ça
http://www.clarion.free.fr/public_ht.../shellexe.html
http://msdn.microsoft.com/en-us/libr...53(VS.85).aspx
http://support.microsoft.com/kb/147807/fr

Mais je ne suis mêmen pas arrivé à les transformer en fonction executables depuis une macro.

Tant pis, voir tant mieux si je doit constituer un module dédié à cette fonctionalité.

Il faut juste que je puisse l'appeller depuis une macro.

Encore merci.

[Domi2]

Bonjour,

Code à coller 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
Option Compare Database
Option Explicit
 
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
 
Public Enum TypeOuverture
 
    imprimer = 1
    ouvrir = 2
 
End Enum
 
Public Sub OuvrirDocument(strCheminFichier As String, Optional Action As TypeOuverture = 2)
 
'--------------------------------------------------------------------------------------------
' Projet          : Interface Windows
' Auteurs         : Romain Puyfoulhoux - http://access.developpez.com
'                   Christophe Warin (Tofalu) - http://access.developpez.com
'                   pour la gestion des erreurs
' Version / Date  : 1.0 / 01.01.2008
' Révision / Date : 1.1 / 11.03.2008 - Modification de l'appel - énumération + passage
'                                      optionnel du type d'action (ouverture ou impression,
'                                      mode ouverture par défaut
'
' Commentaires    : Permet d'ouvrir un fichier sans déclarer l'application a utiliser
'
'                   Exemple d'appel :
'                   Call OuvrirDocument ("C:\Projets Access\Exemple.doc", ouvrir)
'
' Lien            : http://access.developpez.com/faq/?page=Automation#shellexecute
'--------------------------------------------------------------------------------------------
 
    'Déclaration de la variable
    Dim strDescriptionErreur As String
 
    Select Case ShellExecute(0, IIf(Action = ouvrir, "open", "print"), strCheminFichier, vbNullString, vbNullString, 1)
 
        Case 0: strDescriptionErreur = "Le système manque de mémoire ou de ressources, l'exécutable est corrompu ou réallocations non valides."
        Case 2: strDescriptionErreur = "Fichier non trouvé."
        Case 3: strDescriptionErreur = "Chemin non trouvé."
        Case 5: strDescriptionErreur = "Une tentative a été faite pour se lier dynamiquement à une tache, ou il y a eu une erreur de partage ou de protection réseau."
        Case 6: strDescriptionErreur = "La librairie requiert des segments de données séparés pour chaque tâche."
        Case 8: strDescriptionErreur = "Il n 'y a pas assez de mémoire disponible pour lancer l'application."
        Case 10: strDescriptionErreur = "Version de Windows incorrecte."
        Case 11: strDescriptionErreur = "Le fichier exécutable n'est pas correct, il se peut que ce ne soit pas une application Windows, ou qu'il y ait une erreur dans le fichier .EXE;"
        Case 12: strDescriptionErreur = "L'application a été conçue pour un autre système d'exploitation."
        Case 13: strDescriptionErreur = "L'application a été conçue pour MS-DOS 4.0."
        Case 14: strDescriptionErreur = "Le type de fichier exécutable est inconnu."
        Case 15: strDescriptionErreur = "Tentative de chargement d'une application en mode réel."
        Case 16: strDescriptionErreur = "Tentative de charger une seconde instance d'un fichier exécutable contenant plusieurs segments de données qui ne sont pas marqués en lecture seule."
        Case 19: strDescriptionErreur = "Tentative de charger un fichier exécutable compressé. Le fichier doit être décompressé avant d'être chargé."
        Case 20: strDescriptionErreur = "Fichier de librairie liée dynamiquement (DLL) incorrect, une des DLLs requise pour exécuter cette application est corrompue."
        Case 21: strDescriptionErreur = "L'application requiert les extensions Microsoft Windows 32-bit."
        Case 31: strDescriptionErreur = "Il n 'y a pas d'association pour le type de fichier spécifié, ou il n'y a pas d'association pour l'action choisie pour le type de fichier choisi."
 
    End Select
 
    If strDescriptionErreur <> "" Then
 
        MsgBox strDescriptionErreur
 
    End If
 
End Sub

L'exemple d'appel est en remarque.

Comment veux-tu exécuter le code ? Sur clic d'un bouton ?

Domi2

[Access_ible]

Merci.

De mon côté j'ai bourriné sur la recherche et j'ai finalement trouvé ceci :
http://support.microsoft.com/kb/170918/fr

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
 
Option Explicit
 
      Private Declare Function ShellExecute Lib "shell32.dll" Alias _
      "ShellExecuteA" (ByVal hwnd As Long, ByVal lpszOp As _
      String, ByVal lpszFile As String, ByVal lpszParams As String, _
      ByVal lpszDir As String, ByVal FsShowCmd As Long) As Long
 
      Private Declare Function GetDesktopWindow Lib "user32" () As Long
 
      Const SW_SHOWNORMAL = 1
 
      Const SE_ERR_FNF = 2&
      Const SE_ERR_PNF = 3&
      Const SE_ERR_ACCESSDENIED = 5&
      Const SE_ERR_OOM = 8&
      Const SE_ERR_DLLNOTFOUND = 32&
      Const SE_ERR_SHARE = 26&
      Const SE_ERR_ASSOCINCOMPLETE = 27&
      Const SE_ERR_DDETIMEOUT = 28&
      Const SE_ERR_DDEFAIL = 29&
      Const SE_ERR_DDEBUSY = 30&
      Const SE_ERR_NOASSOC = 31&
      Const ERROR_BAD_FORMAT = 11&
 
      Function StartDoc(DocName As String) As Long
          Dim Scr_hDC As Long
          Scr_hDC = GetDesktopWindow()
          StartDoc = ShellExecute(Scr_hDC, "Open", DocName, _
          "", "C:\", SW_SHOWNORMAL)
      End Function
 
      Private Sub Form_Click()
          Dim r As Long, msg As String
          r = StartDoc("C:\WINDOWS\ARCADE.BMP")
          If r <= 32 Then
              'There was an error
              Select Case r
                  Case SE_ERR_FNF
                      msg = "File not found"
                  Case SE_ERR_PNF
                      msg = "Path not found"
                  Case SE_ERR_ACCESSDENIED
                      msg = "Access denied"
                  Case SE_ERR_OOM
                      msg = "Out of memory"
                  Case SE_ERR_DLLNOTFOUND
                      msg = "DLL not found"
                  Case SE_ERR_SHARE
                      msg = "A sharing violation occurred"
                  Case SE_ERR_ASSOCINCOMPLETE
                      msg = "Incomplete or invalid file association"
                  Case SE_ERR_DDETIMEOUT
                      msg = "DDE Time out"
                  Case SE_ERR_DDEFAIL
                      msg = "DDE transaction failed"
                  Case SE_ERR_DDEBUSY
                      msg = "DDE busy"
                  Case SE_ERR_NOASSOC
                      msg = "No association for file extension"
                  Case ERROR_BAD_FORMAT
                      msg = "Invalid EXE file or error in EXE image"
                  Case Else
                      msg = "Unknown error"
              End Select
              MsgBox msg
          End If
      End Sub

Alors, en fait, le code ci-dessus est conçu pour être enregistré dans le visual basic d'un formulaire.

Quand on clique sur le selecteur d'enregistrement du formulaire, le module ce déclenche.

Il faut juste indiquer à la ligne

Code :

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

r = StartDoc("C:\WINDOWS\ARCADE.BMP")

le chemin complet du fichier à executer à la place de "C:\WINDOWS\ARCADE.BMP"

Comme je souhaite déclencher cette fonction depuis une macro, j'ai remplacé la ligne

Code :

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

Private Sub Form_Click()

Qui permet de déclencher le code en cliquant sur un formulaire Par

Code :

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

Public Function NomDeFonction()

Où NomDeFonction est à remplacer par n'importe quel nom, que l'on retrouvera dans la liste des fonctions de la base, éxecutables en code depuis une macro.
et la dernière ligne

Code :

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

End Sub

par

Code :

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

End Function

Par contre, impossible de faire marcher le premier exemple, qui semblais plus light, même après avoir compris comment il fallait s'en servir.
http://support.microsoft.com/kb/147807/fr

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
Option Explicit
 
      Const SW_SHOWNORMAL = 1
 
      Private Declare Function ShellExecute Lib "shell.dll" (ByVal hwnd%, _
      ByVal lpszOp$, ByVal lpszFile$, ByVal spszParams$, ByVal _
      lpszDir$, ByVal fsShowCmd%) As Integer
 
      Private Declare Function GetDesktopWindow Lib "USER" () As Integer
 
      Function StartDoc(DocName As String) As Integer
         Dim Scr_hDC As Integer
         Scr_hDC = GetDesktopWindow()
         StartDoc = ShellExecute(Scr_hDC, "Open", DocName, "", "C:\", _
         SW_SHOWNORMAL)
      End Function
 
      Sub Form_Click()
         Dim r As Integer
         r = StartDoc("C:\WINDOWS\ARCADE.BMP")
      End Sub

ça bogue et me dit que le fichier "USER" est introuvable. J'ai essayé de le remplacer par "user32" mais après c'est le fichier "shell.dll" qui est déclaré introuvable...

Les deux codes les plus long ont pour eux la gestion en clair des erreurs.

Je penses que ça devrait servir à pas mal de monde.

En tous cas merci.