Bonjour,
J'essaie de r=E9cup=E9rer en VBA les noms des groupes de=20
macros stock=E9s dans une macro.
J'arrive =E0 r=E9cup=E9rer le nom de la macro mais pas les=20
macros int=E9gr=E9es.
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
André AVONS
Salut Ci joint un code qui permet de mire et de modifier une macro (ici la macro autokeys) Bien entendu il faut que tu modifies
'?MajAutoKeys("D:GitpCourrierSuiviCourrier.mdb","") Public Function MajAutoKeys(Nombase As String, Optional MDP As Variant) As Boolean
Dim appAccess As Object Dim AKnotExist As Boolean Dim testCtrlT As Boolean, testCtrlI As Boolean Dim MyString As String Const ForReading = 1, ForAppending = 8 Dim fs, f
On Error GoTo MajAutoKeys_Error
Set appAccess = CreateObject("Access.Application") appAccess.OpenCurrentDatabase Nombase, False, MDP appAccess.Application.Echo False
AKnotExist = False '--------------------------------------------------------------------------- ---- 'Suppression du fichier txt '--------------------------------------------------------------------------- ---- Kill fReturnTempDir & "autoKeys.txt" '--------------------------------------------------------------------------- ---- 'Sauvegarde en texte de la macro AutoKeys '--------------------------------------------------------------------------- ---- appAccess.SaveAsText acMacro, "AutoKeys", fReturnTempDir & "autoKeys.txt" '// Exporte la macro dans un fichier txt '--------------------------------------------------------------------------- ---- 'Lecture du fichier texte pour voir si Ctrl t pour MajTextInfoBulleTr existe déja '--------------------------------------------------------------------------- ---- If AKnotExist = False Then Open fReturnTempDir & "autoKeys.txt" For Input As 1 Do While Not EOF(1) ' Effectue la boucle jusqu'à la fin du fichier. Line Input #1, MyString 'Si l'action existe deja pour le formulaire If InStr(1, MyString, "MajTextInfoBulleTr") > 1 Then Close #1 appAccess.DoCmd.Quit acQuitSaveNone MajAutoKeys = True GoTo Fin End If 'Test si la touche ctrl T est deja utilisée If InStr(1, MyString, "^T") > 1 Then testCtrlT = True 'Test si la touche ctrl I est deja utilisée If InStr(1, MyString, "^I") > 1 Then testCtrlI = True Loop Close #1 End If '--------------------------------------------------------------------------- ---- 'Ecriture de l'action de la macro dans le fichier texte '--------------------------------------------------------------------------- ---- 'Si le fichier textte n'existe pas 'Si autokeys n'existe pas Ecriture de l'entete de la macro If AKnotExist = True Then Open fReturnTempDir & "autoKeys.txt" For Output As 1 Print #1, "Version = 196611" & vbCrLf Print #1, "ColumnsShown = 1" & vbCrLf Close #1 End If 'Ajout les lignes de l'action Set fs = CreateObject("Scripting.FileSystemObject") Set f = fs.OpenTextFile(fReturnTempDir & "autoKeys.txt", ForAppending) 'ecriture de l'action pour ouvrir le form f.Write "Begin" & vbCrLf 'Suivant si les touches de ctrl sont déja affectées If testCtrlT = False Then f.Write " MacroName = " & Chr(34) & "^T" & Chr(34) & vbCrLf Else If testCtrlI = False Then f.Write " MacroName = " & Chr(34) & "^I" & Chr(34) & vbCrLf Else f.Write " MacroName = " & Chr(34) & "^B" & Chr(34) & vbCrLf End If End If
Fin: Set f = Nothing Set fs = Nothing Set appAccess = Nothing Exit Function
MajAutoKeys_Error: If Err = 53 Then Resume Next Else If Err = 2001 Then AKnotExist = True Resume Next Else MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure MajAutoKeys of Module Mise à Jour AutoKeys" appAccess.DoCmd.Quit acQuitSaveNone MajAutoKeys = False Resume Fin End If End If
End Function
-- @+ André
Quelques liens avec des exemples, des utilitaires et des compléments pour Access http://access.seneque.free.fr/ http://www.self-access.com/ http://www.mvps.org/accessfr/ http://mypage.bluewin.ch/w.stucki/ http://access.jessy.free.fr/
"Patrick" a écrit dans le message de news: 015001c3b1a3$b46f8960$ Bonjour, J'essaie de récupérer en VBA les noms des groupes de macros stockés dans une macro. J'arrive à récupérer le nom de la macro mais pas les macros intégrées.
Qui pourait m'aider ?
Merci
Salut
Ci joint un code qui permet de mire et de modifier une macro (ici la macro
autokeys)
Bien entendu il faut que tu modifies
'?MajAutoKeys("D:GitpCourrierSuiviCourrier.mdb","")
Public Function MajAutoKeys(Nombase As String, Optional MDP As Variant) As
Boolean
Dim appAccess As Object
Dim AKnotExist As Boolean
Dim testCtrlT As Boolean, testCtrlI As Boolean
Dim MyString As String
Const ForReading = 1, ForAppending = 8
Dim fs, f
On Error GoTo MajAutoKeys_Error
Set appAccess = CreateObject("Access.Application")
appAccess.OpenCurrentDatabase Nombase, False, MDP
appAccess.Application.Echo False
AKnotExist = False
'---------------------------------------------------------------------------
----
'Suppression du fichier txt
'---------------------------------------------------------------------------
----
Kill fReturnTempDir & "autoKeys.txt"
'---------------------------------------------------------------------------
----
'Sauvegarde en texte de la macro AutoKeys
'---------------------------------------------------------------------------
----
appAccess.SaveAsText acMacro, "AutoKeys", fReturnTempDir & "autoKeys.txt"
'// Exporte la macro dans un fichier txt
'---------------------------------------------------------------------------
----
'Lecture du fichier texte pour voir si Ctrl t pour MajTextInfoBulleTr existe
déja
'---------------------------------------------------------------------------
----
If AKnotExist = False Then
Open fReturnTempDir & "autoKeys.txt" For Input As 1
Do While Not EOF(1) ' Effectue la boucle jusqu'à la fin du fichier.
Line Input #1, MyString
'Si l'action existe deja pour le formulaire
If InStr(1, MyString, "MajTextInfoBulleTr") > 1 Then
Close #1
appAccess.DoCmd.Quit acQuitSaveNone
MajAutoKeys = True
GoTo Fin
End If
'Test si la touche ctrl T est deja utilisée
If InStr(1, MyString, "^T") > 1 Then testCtrlT = True
'Test si la touche ctrl I est deja utilisée
If InStr(1, MyString, "^I") > 1 Then testCtrlI = True
Loop
Close #1
End If
'---------------------------------------------------------------------------
----
'Ecriture de l'action de la macro dans le fichier texte
'---------------------------------------------------------------------------
----
'Si le fichier textte n'existe pas
'Si autokeys n'existe pas Ecriture de l'entete de la macro
If AKnotExist = True Then
Open fReturnTempDir & "autoKeys.txt" For Output As 1
Print #1, "Version = 196611" & vbCrLf
Print #1, "ColumnsShown = 1" & vbCrLf
Close #1
End If
'Ajout les lignes de l'action
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.OpenTextFile(fReturnTempDir & "autoKeys.txt", ForAppending)
'ecriture de l'action pour ouvrir le form
f.Write "Begin" & vbCrLf
'Suivant si les touches de ctrl sont déja affectées
If testCtrlT = False Then
f.Write " MacroName = " & Chr(34) & "^T" & Chr(34) & vbCrLf
Else
If testCtrlI = False Then
f.Write " MacroName = " & Chr(34) & "^I" & Chr(34) & vbCrLf
Else
f.Write " MacroName = " & Chr(34) & "^B" & Chr(34) & vbCrLf
End If
End If
Fin:
Set f = Nothing
Set fs = Nothing
Set appAccess = Nothing
Exit Function
MajAutoKeys_Error:
If Err = 53 Then
Resume Next
Else
If Err = 2001 Then
AKnotExist = True
Resume Next
Else
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure
MajAutoKeys of Module Mise à Jour AutoKeys"
appAccess.DoCmd.Quit acQuitSaveNone
MajAutoKeys = False
Resume Fin
End If
End If
End Function
--
@+
André
Quelques liens avec des exemples, des utilitaires et des compléments pour
Access
http://access.seneque.free.fr/
http://www.self-access.com/
http://www.mvps.org/accessfr/
http://mypage.bluewin.ch/w.stucki/
http://access.jessy.free.fr/
"Patrick" <anonymous@discussions.microsoft.com> a écrit dans le message de
news: 015001c3b1a3$b46f8960$a001280a@phx.gbl...
Bonjour,
J'essaie de récupérer en VBA les noms des groupes de
macros stockés dans une macro.
J'arrive à récupérer le nom de la macro mais pas les
macros intégrées.
Salut Ci joint un code qui permet de mire et de modifier une macro (ici la macro autokeys) Bien entendu il faut que tu modifies
'?MajAutoKeys("D:GitpCourrierSuiviCourrier.mdb","") Public Function MajAutoKeys(Nombase As String, Optional MDP As Variant) As Boolean
Dim appAccess As Object Dim AKnotExist As Boolean Dim testCtrlT As Boolean, testCtrlI As Boolean Dim MyString As String Const ForReading = 1, ForAppending = 8 Dim fs, f
On Error GoTo MajAutoKeys_Error
Set appAccess = CreateObject("Access.Application") appAccess.OpenCurrentDatabase Nombase, False, MDP appAccess.Application.Echo False
AKnotExist = False '--------------------------------------------------------------------------- ---- 'Suppression du fichier txt '--------------------------------------------------------------------------- ---- Kill fReturnTempDir & "autoKeys.txt" '--------------------------------------------------------------------------- ---- 'Sauvegarde en texte de la macro AutoKeys '--------------------------------------------------------------------------- ---- appAccess.SaveAsText acMacro, "AutoKeys", fReturnTempDir & "autoKeys.txt" '// Exporte la macro dans un fichier txt '--------------------------------------------------------------------------- ---- 'Lecture du fichier texte pour voir si Ctrl t pour MajTextInfoBulleTr existe déja '--------------------------------------------------------------------------- ---- If AKnotExist = False Then Open fReturnTempDir & "autoKeys.txt" For Input As 1 Do While Not EOF(1) ' Effectue la boucle jusqu'à la fin du fichier. Line Input #1, MyString 'Si l'action existe deja pour le formulaire If InStr(1, MyString, "MajTextInfoBulleTr") > 1 Then Close #1 appAccess.DoCmd.Quit acQuitSaveNone MajAutoKeys = True GoTo Fin End If 'Test si la touche ctrl T est deja utilisée If InStr(1, MyString, "^T") > 1 Then testCtrlT = True 'Test si la touche ctrl I est deja utilisée If InStr(1, MyString, "^I") > 1 Then testCtrlI = True Loop Close #1 End If '--------------------------------------------------------------------------- ---- 'Ecriture de l'action de la macro dans le fichier texte '--------------------------------------------------------------------------- ---- 'Si le fichier textte n'existe pas 'Si autokeys n'existe pas Ecriture de l'entete de la macro If AKnotExist = True Then Open fReturnTempDir & "autoKeys.txt" For Output As 1 Print #1, "Version = 196611" & vbCrLf Print #1, "ColumnsShown = 1" & vbCrLf Close #1 End If 'Ajout les lignes de l'action Set fs = CreateObject("Scripting.FileSystemObject") Set f = fs.OpenTextFile(fReturnTempDir & "autoKeys.txt", ForAppending) 'ecriture de l'action pour ouvrir le form f.Write "Begin" & vbCrLf 'Suivant si les touches de ctrl sont déja affectées If testCtrlT = False Then f.Write " MacroName = " & Chr(34) & "^T" & Chr(34) & vbCrLf Else If testCtrlI = False Then f.Write " MacroName = " & Chr(34) & "^I" & Chr(34) & vbCrLf Else f.Write " MacroName = " & Chr(34) & "^B" & Chr(34) & vbCrLf End If End If
Fin: Set f = Nothing Set fs = Nothing Set appAccess = Nothing Exit Function
MajAutoKeys_Error: If Err = 53 Then Resume Next Else If Err = 2001 Then AKnotExist = True Resume Next Else MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure MajAutoKeys of Module Mise à Jour AutoKeys" appAccess.DoCmd.Quit acQuitSaveNone MajAutoKeys = False Resume Fin End If End If
End Function
-- @+ André
Quelques liens avec des exemples, des utilitaires et des compléments pour Access http://access.seneque.free.fr/ http://www.self-access.com/ http://www.mvps.org/accessfr/ http://mypage.bluewin.ch/w.stucki/ http://access.jessy.free.fr/
"Patrick" a écrit dans le message de news: 015001c3b1a3$b46f8960$ Bonjour, J'essaie de récupérer en VBA les noms des groupes de macros stockés dans une macro. J'arrive à récupérer le nom de la macro mais pas les macros intégrées.
