Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel Lister toutes les macros sur un PC

Lister toutes les macros sur un PC

13 réponses
Avatar
Christophe
Bonjour:

Est-il possible de lister/identifier toutes les macros rattach=E9es =E0
des fichiers excel sur un PC?

Merci par avance pour votre aide et bonne journ=E9e.

Christophe
Signaler un problème avec ce contenu

10 réponses

Supprimer
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
1 2
Avatar
MichDenis
Pour obternir dans la feuil1, la liste des procédures et fonctionss et le
nom du module où elles sont situées :

'=============================== Sub test()
Dim Vcomp As Object, T As Integer
Dim Sh As Worksheet, S As String, LIg As Integer

Set Sh = Worksheets("Feuil1")
For Each Vcomp In ThisWorkbook.VBProject.VBComponents
With Vcomp
If Vcomp.Name <> "Module1" Then
With .CodeModule
T = .CountOfLines
For a = 1 To T
S = .Lines(a, 1)
If InStr(1, S, "End", vbTextCompare) = 0 Then
If InStr(1, S, "sub", vbTextCompare) <> 0 Then
LIg = LIg + 1
Sh.Range("A" & LIg) = .Name
Sh.Range("B" & LIg) = S
ElseIf InStr(1, S, "Function", vbTextCompare) <> 0 Then
LIg = LIg + 1
Sh.Range("A" & LIg) = .Name
Sh.Range("B" & LIg) = S
End If
End If
Next
End With
End If
End With
Next
End Sub
'===============================




"Christophe" a écrit dans le message de news:

Bonjour:

Est-il possible de lister/identifier toutes les macros rattachées à
des fichiers excel sur un PC?

Merci par avance pour votre aide et bonne journée.

Christophe
Avatar
MichDenis
Voici une procédure qui copie dans un fichier texte toutes
les macros de chacun des fichiers des lecteurs C:, D: et J

Chaque fichier texte est créé dans le répertoire "c:Denis"
la macro se charge de créer ce répertoire si il n'existe pas.

Dans chaque fichier texte, on retrouve en haut,
le nom et le chemin complet du fichier.xls d'où provient
le code. De même, chaque module d'où provient le code
est identifié ... il est suivi du code qui lui appartient.

Attention, le code risque d'être longuet si la procédure doit faire
une recherche sur la totalité des lecteurs. Pour ce faire, tu peux
mettre à true ou à false cette ligne de code :
.SearchSubFolders = False dans la procédure Test

Comme ce code n'a pas été testé à fond, il est toujours
possible qu'il y ait des petits pépins !!! ;-)

'----------------------------------------------------
Sub test11()
Dim X As Integer, A As Integer
Dim Chemin As String

' Où sera copié le code de chaque ficnier
'chaque fichier aura un fichier texte si
'code trouvé dans ce répertoire
Chemin = "c:Denis"
Application.ScreenUpdating = False
For Each elt In Array("c:", "D:" , "J:")
With Application.FileSearch
.NewSearch
.LookIn = elt
.FileName = "*.xls"
.SearchSubFolders = True
If .Execute > 0 Then
X = .FoundFiles.Count
For A = 1 To X
If .FoundFiles(A) <> ThisWorkbook.FullName Then
ExtraireLeCode .FoundFiles(A), Chemin
End If
Next
End If
End With
Next
End Sub
'-------------------------------------------
Sub ExtraireLeCode(Fichier As String, Chemin As String)
Dim Code As String, Wk As Workbook
Dim Comp As VBComponent, Temp As String

Application.DisplayAlerts = False
Set Wk = Workbooks.Open(Fichier)
If Wk.HasPassword Then
Wk.Password = InputBox( _
"Entrer le mot de passe pour ce fichier: " & Wk.FullName)
End If
If Wk.VBProject.Protection = vbext_pp_locked Then
MsgBox "Le code de ce fichier est protégé." & _
" Le code n'a pas été copié." & vbCrLf & vbCrLf & _
Wk.FullName, vbCritical _
+ vbOKOnly, "Attention"
Wk.Close False
Exit Sub
End If

Code = vbCrLf & Wk.FullName & vbCrLf & vbCrLf
For Each Comp In Wk.VBProject.VBComponents
With Comp.codemodule
Temp = ""
On Error Resume Next
Temp = .Lines(1, .CountOfLines)
If Err = 0 Then
Code = Code & vbCrLf
Code = Code & Comp.Name & vbCrLf & vbCrLf
Code = Code & Temp & vbCrLf
Code = Code & vbCrLf
Else
Err = 0
End If
End With
Next
If Code <> vbCrLf & Wk.FullName & vbCrLf & vbCrLf Then
EcrireCodeDansFichierTexte _
Replace(Wk.Name, ".xls", ""), Chemin, Code
End If
Wk.Close False
End Sub
'-------------------------------------------
Sub EcrireCodeDansFichierTexte(SonNom As String, _
Chemin As String, Code As String)

Dim F As Long
If Dir(Chemin, vbDirectory) = "" Then
VBA.MkDir Chemin
End If
F = FreeFile
Vers = Chemin & SonNom & ".txt"
Open Vers For Output As #F
Write #F, Code
Close #F
End Sub
'-------------------------------------------
Avatar
Christophe
Bonjour Michel:

Merci mille fois pour le post. Est-ce que tu peux confirmer que dans
ce cas les macros peuvent être identifiées sans que les fichiers
Excel soient ouverts?
J'obtiens une Compile error: "User-defined type not defined" au niveau
de la ligne/bloc Dim Comp As VBComponent, Temp As String

Remerciements et sinceres salutations.

Christophe

On Jan 24, 6:52 pm, "MichDenis" wrote:
Voici une procédure qui copie dans un fichier texte toutes
les macros de chacun des fichiers des lecteurs C:, D: et J

Chaque fichier texte est créé dans le répertoire "c:Denis"
la macro se charge de créer ce répertoire si il n'existe pas.

Dans chaque fichier texte, on retrouve en haut,
le nom et le chemin complet du fichier.xls d'où provient
le code. De même, chaque module d'où provient le code
est identifié ... il est suivi du code qui lui appartient.

Attention, le code risque d'être longuet si la procédure doit faire
une recherche sur la totalité des lecteurs. Pour ce faire, tu peux
mettre à true ou à false cette ligne de code :
.SearchSubFolders = False dans la procédure Test

Comme ce code n'a pas été testé à fond, il est toujours
possible qu'il y ait des petits pépins !!! ;-)

'----------------------------------------------------
Sub test11()
Dim X As Integer, A As Integer
Dim Chemin As String

' Où sera copié le code de chaque ficnier
'chaque fichier aura un fichier texte si
'code trouvé dans ce répertoire
Chemin = "c:Denis"
Application.ScreenUpdating = False
For Each elt In Array("c:", "D:" , "J:")
With Application.FileSearch
.NewSearch
.LookIn = elt
.FileName = "*.xls"
.SearchSubFolders = True
If .Execute > 0 Then
X = .FoundFiles.Count
For A = 1 To X
If .FoundFiles(A) <> ThisWorkbook.FullName Then
ExtraireLeCode .FoundFiles(A), Chemin
End If
Next
End If
End With
Next
End Sub
'-------------------------------------------
Sub ExtraireLeCode(Fichier As String, Chemin As String)
Dim Code As String, Wk As Workbook
Dim Comp As VBComponent, Temp As String

Application.DisplayAlerts = False
Set Wk = Workbooks.Open(Fichier)
If Wk.HasPassword Then
Wk.Password = InputBox( _
"Entrer le mot de passe pour ce fichier: " & Wk.FullName)
End If
If Wk.VBProject.Protection = vbext_pp_locked Then
MsgBox "Le code de ce fichier est protégé." & _
" Le code n'a pas été copié." & vbCrLf & vbCrLf & _
Wk.FullName, vbCritical _
+ vbOKOnly, "Attention"
Wk.Close False
Exit Sub
End If

Code = vbCrLf & Wk.FullName & vbCrLf & vbCrLf
For Each Comp In Wk.VBProject.VBComponents
With Comp.codemodule
Temp = ""
On Error Resume Next
Temp = .Lines(1, .CountOfLines)
If Err = 0 Then
Code = Code & vbCrLf
Code = Code & Comp.Name & vbCrLf & vbCrLf
Code = Code & Temp & vbCrLf
Code = Code & vbCrLf
Else
Err = 0
End If
End With
Next
If Code <> vbCrLf & Wk.FullName & vbCrLf & vbCrLf Then
EcrireCodeDansFichierTexte _
Replace(Wk.Name, ".xls", ""), Chemin, Code
End If
Wk.Close False
End Sub
'-------------------------------------------
Sub EcrireCodeDansFichierTexte(SonNom As String, _
Chemin As String, Code As String)

Dim F As Long
If Dir(Chemin, vbDirectory) = "" Then
VBA.MkDir Chemin
End If
F = FreeFile
Vers = Chemin & SonNom & ".txt"
Open Vers For Output As #F
Write #F, Code
Close #F
End Sub
'-------------------------------------------


Avatar
MichDenis
Remplace ceci :
Dim Comp As VBComponent
Par
Dim Comp As Object

Et si tu veux garder
Dim Comp As VBComponent
tu dois déclarer la bibliothèque suivante :
"Microsoft Visual basic for application extensibility 5.3"


| Est-ce que tu peux confirmer que dans ce cas les macros
| peuvent être identifiées sans que les fichiers Excel soient
| ouverts?

Non, la macro doit ouvrir les fichiers un à un pour en extraire
le code. Tous les fichiers Excel dont le projet VBA est protégé
par mot de passe sont inaccessibles par la macro. À chaque
classeur que la macro va rencontrer tu auras un message te
spécifiant le nom du classeur qu'elle ne peut pas copier le code.

Si tu lances la macro, telle qu'elle est écrite, l'exécution de celle-ci
pourrait prendre un bon moment (quelques minutes) car avant d'ouvrir
chacun des classeurs, elle doit scanner chacun des lecteurs pour extraire
la liste des fichiers Excel que le lecteur possède.

Chaque fichier texte est baptisé du nom du fichier Excel dont les macros
proviennent.... j'espère que tu n'as pas de doublons dans les noms de
tes fichiers Excel sinon il faudra modifier légèrement comment la procédure
nomme les fichiers texte.



"Christophe" a écrit dans le message de news:


Bonjour Michel:

Merci mille fois pour le post. Est-ce que tu peux confirmer que dans
ce cas les macros peuvent être identifiées sans que les fichiers
Excel soient ouverts?
J'obtiens une Compile error: "User-defined type not defined" au niveau
de la ligne/bloc Dim Comp As VBComponent, Temp As String

Remerciements et sinceres salutations.

Christophe

On Jan 24, 6:52 pm, "MichDenis" wrote:
Voici une procédure qui copie dans un fichier texte toutes
les macros de chacun des fichiers des lecteurs C:, D: et J

Chaque fichier texte est créé dans le répertoire "c:Denis"
la macro se charge de créer ce répertoire si il n'existe pas.

Dans chaque fichier texte, on retrouve en haut,
le nom et le chemin complet du fichier.xls d'où provient
le code. De même, chaque module d'où provient le code
est identifié ... il est suivi du code qui lui appartient.

Attention, le code risque d'être longuet si la procédure doit faire
une recherche sur la totalité des lecteurs. Pour ce faire, tu peux
mettre à true ou à false cette ligne de code :
.SearchSubFolders = False dans la procédure Test

Comme ce code n'a pas été testé à fond, il est toujours
possible qu'il y ait des petits pépins !!! ;-)

'----------------------------------------------------
Sub test11()
Dim X As Integer, A As Integer
Dim Chemin As String

' Où sera copié le code de chaque ficnier
'chaque fichier aura un fichier texte si
'code trouvé dans ce répertoire
Chemin = "c:Denis"
Application.ScreenUpdating = False
For Each elt In Array("c:", "D:" , "J:")
With Application.FileSearch
.NewSearch
.LookIn = elt
.FileName = "*.xls"
.SearchSubFolders = True
If .Execute > 0 Then
X = .FoundFiles.Count
For A = 1 To X
If .FoundFiles(A) <> ThisWorkbook.FullName Then
ExtraireLeCode .FoundFiles(A), Chemin
End If
Next
End If
End With
Next
End Sub
'-------------------------------------------
Sub ExtraireLeCode(Fichier As String, Chemin As String)
Dim Code As String, Wk As Workbook
Dim Comp As VBComponent, Temp As String

Application.DisplayAlerts = False
Set Wk = Workbooks.Open(Fichier)
If Wk.HasPassword Then
Wk.Password = InputBox( _
"Entrer le mot de passe pour ce fichier: " & Wk.FullName)
End If
If Wk.VBProject.Protection = vbext_pp_locked Then
MsgBox "Le code de ce fichier est protégé." & _
" Le code n'a pas été copié." & vbCrLf & vbCrLf & _
Wk.FullName, vbCritical _
+ vbOKOnly, "Attention"
Wk.Close False
Exit Sub
End If

Code = vbCrLf & Wk.FullName & vbCrLf & vbCrLf
For Each Comp In Wk.VBProject.VBComponents
With Comp.codemodule
Temp = ""
On Error Resume Next
Temp = .Lines(1, .CountOfLines)
If Err = 0 Then
Code = Code & vbCrLf
Code = Code & Comp.Name & vbCrLf & vbCrLf
Code = Code & Temp & vbCrLf
Code = Code & vbCrLf
Else
Err = 0
End If
End With
Next
If Code <> vbCrLf & Wk.FullName & vbCrLf & vbCrLf Then
EcrireCodeDansFichierTexte _
Replace(Wk.Name, ".xls", ""), Chemin, Code
End If
Wk.Close False
End Sub
'-------------------------------------------
Sub EcrireCodeDansFichierTexte(SonNom As String, _
Chemin As String, Code As String)

Dim F As Long
If Dir(Chemin, vbDirectory) = "" Then
VBA.MkDir Chemin
End If
F = FreeFile
Vers = Chemin & SonNom & ".txt"
Open Vers For Output As #F
Write #F, Code
Close #F
End Sub
'-------------------------------------------


Avatar
Christophe
Michel:

Merci. Je viens de tester ta macro qui à n'en pas douter fonction
parfaitement comme le confireme Marianne. Malheureusement pour ma part
je rencontre encore un problème (Run-time error 1004) au niveau de
Set Wk = Workbooks.Open(Fichier) dans Sub ExtraireLeCode(Fichier As
String, Chemin As String)

En fait la macro essaie d'ouvrir des fichiers temporaires xls créés
lorsque l'on ouvre par exemple un fichier excel joint dans LotusNotes
et ne les trouve pas parce qu'il s'agit de fichier temporaires qui ont
été vraissemblablement renommés ou supprimés ce qui explique le
plantage. Existe t-il un moyen de ne pas considérer les fichiers exel
que l'on ne trouve plus?

Sincères salutations.

Christophe

On Jan 25, 4:18 pm, "MichDenis" wrote:
Remplace ceci :
Dim Comp As VBComponent
Par
Dim Comp As Object

Et si tu veux garder
Dim Comp As VBComponent
tu dois déclarer la bibliothèque suivante :
"Microsoft Visual basic for application extensibility 5.3"

| Est-ce que tu peux confirmer que dans ce cas les macros
| peuvent être identifiées sans que les fichiers Excel soient
| ouverts?

Non, la macro doit ouvrir les fichiers un à un pour en extraire
le code. Tous les fichiers Excel dont le projet VBA est protégé
par mot de passe sont inaccessibles par la macro. À chaque
classeur que la macro va rencontrer tu auras un message te
spécifiant le nom du classeur qu'elle ne peut pas copier le code.

Si tu lances la macro, telle qu'elle est écrite, l'exécution de celle -ci
pourrait prendre un bon moment (quelques minutes) car avant d'ouvrir
chacun des classeurs, elle doit scanner chacun des lecteurs pour extraire
la liste des fichiers Excel que le lecteur possède.

Chaque fichier texte est baptisé du nom du fichier Excel dont les macros
proviennent.... j'espère que tu n'as pas de doublons dans les noms de
tes fichiers Excel sinon il faudra modifier légèrement comment la pro cédure
nomme les fichiers texte.

"Christophe" a écrit dans le message de news:


Bonjour Michel:

Merci mille fois pour le post. Est-ce que tu peux confirmer que dans
ce cas les macros peuvent être identifiées sans que les fichiers
Excel soient ouverts?
J'obtiens une Compile error: "User-defined type not defined" au niveau
de la ligne/bloc Dim Comp As VBComponent, Temp As String

Remerciements et sinceres salutations.

Christophe

On Jan 24, 6:52 pm, "MichDenis" wrote:



Voici une procédure qui copie dans un fichier texte toutes
les macros de chacun des fichiers des lecteurs C:, D: et J

Chaque fichier texte est créé dans le répertoire "c:Denis"
la macro se charge de créer ce répertoire si il n'existe pas.

Dans chaque fichier texte, on retrouve en haut,
le nom et le chemin complet du fichier.xls d'où provient
le code. De même, chaque module d'où provient le code
est identifié ... il est suivi du code qui lui appartient.

Attention, le code risque d'être longuet si la procédure doit faire
une recherche sur la totalité des lecteurs. Pour ce faire, tu peux
mettre à true ou à false cette ligne de code :
.SearchSubFolders = False dans la procédure Test

Comme ce code n'a pas été testé à fond, il est toujours
possible qu'il y ait des petits pépins !!! ;-)

'----------------------------------------------------
Sub test11()
Dim X As Integer, A As Integer
Dim Chemin As String

' Où sera copié le code de chaque ficnier
'chaque fichier aura un fichier texte si
'code trouvé dans ce répertoire
Chemin = "c:Denis"
Application.ScreenUpdating = False
For Each elt In Array("c:", "D:" , "J:")
With Application.FileSearch
.NewSearch
.LookIn = elt
.FileName = "*.xls"
.SearchSubFolders = True
If .Execute > 0 Then
X = .FoundFiles.Count
For A = 1 To X
If .FoundFiles(A) <> ThisWorkbook.FullName Then
ExtraireLeCode .FoundFiles(A), Chemin
End If
Next
End If
End With
Next
End Sub
'-------------------------------------------
Sub ExtraireLeCode(Fichier As String, Chemin As String)
Dim Code As String, Wk As Workbook
Dim Comp As VBComponent, Temp As String

Application.DisplayAlerts = False
Set Wk = Workbooks.Open(Fichier)
If Wk.HasPassword Then
Wk.Password = InputBox( _
"Entrer le mot de passe pour ce fichier: " & Wk.FullName)
End If
If Wk.VBProject.Protection = vbext_pp_locked Then
MsgBox "Le code de ce fichier est protégé." & _
" Le code n'a pas été copié." & vbCrLf & vbCrLf & _
Wk.FullName, vbCritical _
+ vbOKOnly, "Attention"
Wk.Close False
Exit Sub
End If

Code = vbCrLf & Wk.FullName & vbCrLf & vbCrLf
For Each Comp In Wk.VBProject.VBComponents
With Comp.codemodule
Temp = ""
On Error Resume Next
Temp = .Lines(1, .CountOfLines)
If Err = 0 Then
Code = Code & vbCrLf
Code = Code & Comp.Name & vbCrLf & vbCrLf
Code = Code & Temp & vbCrLf
Code = Code & vbCrLf
Else
Err = 0
End If
End With
Next
If Code <> vbCrLf & Wk.FullName & vbCrLf & vbCrLf Then
EcrireCodeDansFichierTexte _
Replace(Wk.Name, ".xls", ""), Chemin, Code
End If
Wk.Close False
End Sub
'-------------------------------------------
Sub EcrireCodeDansFichierTexte(SonNom As String, _
Chemin As String, Code As String)

Dim F As Long
If Dir(Chemin, vbDirectory) = "" Then
VBA.MkDir Chemin
End If
F = FreeFile
Vers = Chemin & SonNom & ".txt"
Open Vers For Output As #F
Write #F, Code
Close #F
End Sub
'-------------------------------------------- Hide quoted text -- Show quoted text -




Avatar
MichDenis
| essaie d'ouvrir des fichiers temporaires xls

De quoi ont l'air tes fichiers temporaires dans l'explorateur Windows ?
(leur orthographe)


"Christophe" a écrit dans le message de news:

Michel:

Merci. Je viens de tester ta macro qui à n'en pas douter fonction
parfaitement comme le confireme Marianne. Malheureusement pour ma part
je rencontre encore un problème (Run-time error 1004) au niveau de
Set Wk = Workbooks.Open(Fichier) dans Sub ExtraireLeCode(Fichier As
String, Chemin As String)

En fait la macro essaie d'ouvrir des fichiers temporaires xls créés
lorsque l'on ouvre par exemple un fichier excel joint dans LotusNotes
et ne les trouve pas parce qu'il s'agit de fichier temporaires qui ont
été vraissemblablement renommés ou supprimés ce qui explique le
plantage. Existe t-il un moyen de ne pas considérer les fichiers exel
que l'on ne trouve plus?

Sincères salutations.

Christophe

On Jan 25, 4:18 pm, "MichDenis" wrote:
Remplace ceci :
Dim Comp As VBComponent
Par
Dim Comp As Object

Et si tu veux garder
Dim Comp As VBComponent
tu dois déclarer la bibliothèque suivante :
"Microsoft Visual basic for application extensibility 5.3"

| Est-ce que tu peux confirmer que dans ce cas les macros
| peuvent être identifiées sans que les fichiers Excel soient
| ouverts?

Non, la macro doit ouvrir les fichiers un à un pour en extraire
le code. Tous les fichiers Excel dont le projet VBA est protégé
par mot de passe sont inaccessibles par la macro. À chaque
classeur que la macro va rencontrer tu auras un message te
spécifiant le nom du classeur qu'elle ne peut pas copier le code.

Si tu lances la macro, telle qu'elle est écrite, l'exécution de celle-ci
pourrait prendre un bon moment (quelques minutes) car avant d'ouvrir
chacun des classeurs, elle doit scanner chacun des lecteurs pour extraire
la liste des fichiers Excel que le lecteur possède.

Chaque fichier texte est baptisé du nom du fichier Excel dont les macros
proviennent.... j'espère que tu n'as pas de doublons dans les noms de
tes fichiers Excel sinon il faudra modifier légèrement comment la procédure
nomme les fichiers texte.

"Christophe" a écrit dans le message de news:


Bonjour Michel:

Merci mille fois pour le post. Est-ce que tu peux confirmer que dans
ce cas les macros peuvent être identifiées sans que les fichiers
Excel soient ouverts?
J'obtiens une Compile error: "User-defined type not defined" au niveau
de la ligne/bloc Dim Comp As VBComponent, Temp As String

Remerciements et sinceres salutations.

Christophe

On Jan 24, 6:52 pm, "MichDenis" wrote:



Voici une procédure qui copie dans un fichier texte toutes
les macros de chacun des fichiers des lecteurs C:, D: et J

Chaque fichier texte est créé dans le répertoire "c:Denis"
la macro se charge de créer ce répertoire si il n'existe pas.

Dans chaque fichier texte, on retrouve en haut,
le nom et le chemin complet du fichier.xls d'où provient
le code. De même, chaque module d'où provient le code
est identifié ... il est suivi du code qui lui appartient.

Attention, le code risque d'être longuet si la procédure doit faire
une recherche sur la totalité des lecteurs. Pour ce faire, tu peux
mettre à true ou à false cette ligne de code :
.SearchSubFolders = False dans la procédure Test

Comme ce code n'a pas été testé à fond, il est toujours
possible qu'il y ait des petits pépins !!! ;-)

'----------------------------------------------------
Sub test11()
Dim X As Integer, A As Integer
Dim Chemin As String

' Où sera copié le code de chaque ficnier
'chaque fichier aura un fichier texte si
'code trouvé dans ce répertoire
Chemin = "c:Denis"
Application.ScreenUpdating = False
For Each elt In Array("c:", "D:" , "J:")
With Application.FileSearch
.NewSearch
.LookIn = elt
.FileName = "*.xls"
.SearchSubFolders = True
If .Execute > 0 Then
X = .FoundFiles.Count
For A = 1 To X
If .FoundFiles(A) <> ThisWorkbook.FullName Then
ExtraireLeCode .FoundFiles(A), Chemin
End If
Next
End If
End With
Next
End Sub
'-------------------------------------------
Sub ExtraireLeCode(Fichier As String, Chemin As String)
Dim Code As String, Wk As Workbook
Dim Comp As VBComponent, Temp As String

Application.DisplayAlerts = False
Set Wk = Workbooks.Open(Fichier)
If Wk.HasPassword Then
Wk.Password = InputBox( _
"Entrer le mot de passe pour ce fichier: " & Wk.FullName)
End If
If Wk.VBProject.Protection = vbext_pp_locked Then
MsgBox "Le code de ce fichier est protégé." & _
" Le code n'a pas été copié." & vbCrLf & vbCrLf & _
Wk.FullName, vbCritical _
+ vbOKOnly, "Attention"
Wk.Close False
Exit Sub
End If

Code = vbCrLf & Wk.FullName & vbCrLf & vbCrLf
For Each Comp In Wk.VBProject.VBComponents
With Comp.codemodule
Temp = ""
On Error Resume Next
Temp = .Lines(1, .CountOfLines)
If Err = 0 Then
Code = Code & vbCrLf
Code = Code & Comp.Name & vbCrLf & vbCrLf
Code = Code & Temp & vbCrLf
Code = Code & vbCrLf
Else
Err = 0
End If
End With
Next
If Code <> vbCrLf & Wk.FullName & vbCrLf & vbCrLf Then
EcrireCodeDansFichierTexte _
Replace(Wk.Name, ".xls", ""), Chemin, Code
End If
Wk.Close False
End Sub
'-------------------------------------------
Sub EcrireCodeDansFichierTexte(SonNom As String, _
Chemin As String, Code As String)

Dim F As Long
If Dir(Chemin, vbDirectory) = "" Then
VBA.MkDir Chemin
End If
F = FreeFile
Vers = Chemin & SonNom & ".txt"
Open Vers For Output As #F
Write #F, Code
Close #F
End Sub
'-------------------------------------------- Hide quoted text -- Show quoted text -




Avatar
Christophe
Merci Michel et désolé pour le peu réactivité.

Le message d'erreur exact est le suivant:
--------------------------------------------------------------------------- --------------------------------------------------------------------------- ----------------------------------------------
Microsoft Visual Basic
Run-Time error '1004':

'C:Documents and SettingsChristophe JolyLocal SettingsTemp
notes5852E6~0590896.XLS' could not be found.
Check the spelling of the file, and verify that the file location is
correct.

If you are trying toi open a file from upur list of most recently used
files on the File menu, make sure that the file has not been renamed.
--------------------------------------------------------------------------- --------------------------------------------------------------------------- ----------------------------------------------

Merci par avance.

Christophe



On Jan 29, 5:27 pm, "MichDenis" wrote:
| essaie d'ouvrir des fichiers temporaires xls

De quoi ont l'air tes fichiers temporaires dans l'explorateur Windows ?
(leur orthographe)

"Christophe" a écrit dans le message de news:

Michel:

Merci. Je viens de tester ta macro qui à n'en pas douter fonction
parfaitement comme le confireme Marianne. Malheureusement pour ma part
je rencontre encore un problème (Run-time error 1004) au niveau de
Set Wk = Workbooks.Open(Fichier) dans Sub ExtraireLeCode(Fichier As
String, Chemin As String)

En fait la macro essaie d'ouvrir des fichiers temporaires xls créés
lorsque l'on ouvre par exemple un fichier excel joint dans LotusNotes
et ne les trouve pas parce qu'il s'agit de fichier temporaires qui ont
été vraissemblablement renommés ou supprimés ce qui explique le
plantage. Existe t-il un moyen de ne pas considérer les fichiers exel
que l'on ne trouve plus?

Sincères salutations.

Christophe

On Jan 25, 4:18 pm, "MichDenis" wrote:



Remplace ceci :
Dim Comp As VBComponent
Par
Dim Comp As Object

Et si tu veux garder
Dim Comp As VBComponent
tu dois déclarer la bibliothèque suivante :
"Microsoft Visual basic for application extensibility 5.3"

| Est-ce que tu peux confirmer que dans ce cas les macros
| peuvent être identifiées sans que les fichiers Excel soient
| ouverts?

Non, la macro doit ouvrir les fichiers un à un pour en extraire
le code. Tous les fichiers Excel dont le projet VBA est protégé
par mot de passe sont inaccessibles par la macro. À chaque
classeur que la macro va rencontrer tu auras un message te
spécifiant le nom du classeur qu'elle ne peut pas copier le code.

Si tu lances la macro, telle qu'elle est écrite, l'exécution de cel le-ci
pourrait prendre un bon moment (quelques minutes) car avant d'ouvrir
chacun des classeurs, elle doit scanner chacun des lecteurs pour extrai re
la liste des fichiers Excel que le lecteur possède.

Chaque fichier texte est baptisé du nom du fichier Excel dont les mac ros
proviennent.... j'espère que tu n'as pas de doublons dans les noms de
tes fichiers Excel sinon il faudra modifier légèrement comment la p rocédure
nomme les fichiers texte.

"Christophe" a écrit dans le message de news:


Bonjour Michel:

Merci mille fois pour le post. Est-ce que tu peux confirmer que dans
ce cas les macros peuvent être identifiées sans que les fichiers
Excel soient ouverts?
J'obtiens une Compile error: "User-defined type not defined" au niveau
de la ligne/bloc Dim Comp As VBComponent, Temp As String

Remerciements et sinceres salutations.

Christophe

On Jan 24, 6:52 pm, "MichDenis" wrote:

Voici une procédure qui copie dans un fichier texte toutes
les macros de chacun des fichiers des lecteurs C:, D: et J

Chaque fichier texte est créé dans le répertoire "c:Denis"
la macro se charge de créer ce répertoire si il n'existe pas.

Dans chaque fichier texte, on retrouve en haut,
le nom et le chemin complet du fichier.xls d'où provient
le code. De même, chaque module d'où provient le code
est identifié ... il est suivi du code qui lui appartient.

Attention, le code risque d'être longuet si la procédure doit fai re
une recherche sur la totalité des lecteurs. Pour ce faire, tu peux
mettre à true ou à false cette ligne de code :
.SearchSubFolders = False dans la procédure Test

Comme ce code n'a pas été testé à fond, il est toujours
possible qu'il y ait des petits pépins !!! ;-)

'----------------------------------------------------
Sub test11()
Dim X As Integer, A As Integer
Dim Chemin As String

' Où sera copié le code de chaque ficnier
'chaque fichier aura un fichier texte si
'code trouvé dans ce répertoire
Chemin = "c:Denis"
Application.ScreenUpdating = False
For Each elt In Array("c:", "D:" , "J:")
With Application.FileSearch
.NewSearch
.LookIn = elt
.FileName = "*.xls"
.SearchSubFolders = True
If .Execute > 0 Then
X = .FoundFiles.Count
For A = 1 To X
If .FoundFiles(A) <> ThisWorkbook.FullName Then
ExtraireLeCode .FoundFiles(A), Chemin
End If
Next
End If
End With
Next
End Sub
'-------------------------------------------
Sub ExtraireLeCode(Fichier As String, Chemin As String)
Dim Code As String, Wk As Workbook
Dim Comp As VBComponent, Temp As String

Application.DisplayAlerts = False
Set Wk = Workbooks.Open(Fichier)
If Wk.HasPassword Then
Wk.Password = InputBox( _
"Entrer le mot de passe pour ce fichier: " & Wk.FullName)
End If
If Wk.VBProject.Protection = vbext_pp_locked Then
MsgBox "Le code de ce fichier est protégé." & _
" Le code n'a pas été copié." & vbCrLf & vbCrLf & _
Wk.FullName, vbCritical _
+ vbOKOnly, "Attention"
Wk.Close False
Exit Sub
End If

Code = vbCrLf & Wk.FullName & vbCrLf & vbCrLf
For Each Comp In Wk.VBProject.VBComponents
With Comp.codemodule
Temp = ""
On Error Resume Next
Temp = .Lines(1, .CountOfLines)
If Err = 0 Then
Code = Code & vbCrLf
Code = Code & Comp.Name & vbCrLf & vbCrLf
Code = Code & Temp & vbCrLf
Code = Code & vbCrLf
Else
Err = 0
End If
End With
Next
If Code <> vbCrLf & Wk.FullName & vbCrLf & vbCrLf Then
EcrireCodeDansFichierTexte _
Replace(Wk.Name, ".xls", ""), Chemin, Code
End If
Wk.Close False
End Sub
'-------------------------------------------
Sub EcrireCodeDansFichierTexte(SonNom As String, _
Chemin As String, Code As String)

Dim F As Long
If Dir(Chemin, vbDirectory) = "" Then
VBA.MkDir Chemin
End If
F = FreeFile
Vers = Chemin & SonNom & ".txt"
Open Vers For Output As #F
Write #F, Code
Close #F
End Sub
'-------------------------------------------- Hide quoted text -- Sho w quoted text -- Hide quoted text -



- Show quoted text -




Avatar
Christophe
Michel:

J'ai testé la macro sur un autre ordinateur afin d'éviter le problème
rencontré avec les fichiers "temporaires" excel mais malheureusement
je recois le message d'erreur suivant:

Erreur d'Execution "1004"
L'acces du programme a Visual Basic n'est pas fiable.

Quand je clique sur débogage j'arrive sur la ligne suivante:
For Each Comp In Wk.VBProject.VBComponents

Merci.

Christophe
On 29 jan, 17:27, "MichDenis" wrote:
| essaie d'ouvrir des fichiers temporaires xls

De quoi ont l'air tes fichiers temporaires dans l'explorateur Windows ?
(leur orthographe)

"Christophe" a écrit dans le message de news:

Michel:

Merci. Je viens de tester ta macro qui à n'en pas douter fonction
parfaitement comme le confireme Marianne. Malheureusement pour ma part
je rencontre encore un problème (Run-time error 1004) au niveau de
Set Wk = Workbooks.Open(Fichier) dans Sub ExtraireLeCode(Fichier As
String, Chemin As String)

En fait la macro essaie d'ouvrir des fichiers temporaires xls créés
lorsque l'on ouvre par exemple un fichier excel joint dans LotusNotes
et ne les trouve pas parce qu'il s'agit de fichier temporaires qui ont
été vraissemblablement renommés ou supprimés ce qui explique le
plantage. Existe t-il un moyen de ne pas considérer les fichiers exel
que l'on ne trouve plus?

Sincères salutations.

Christophe

On Jan 25, 4:18 pm, "MichDenis" wrote:



Remplace ceci :
Dim Comp As VBComponent
Par
Dim Comp As Object

Et si tu veux garder
Dim Comp As VBComponent
tu dois déclarer la bibliothèque suivante :
"Microsoft Visual basic for application extensibility 5.3"

| Est-ce que tu peux confirmer que dans ce cas les macros
| peuvent être identifiées sans que les fichiers Excel soient
| ouverts?

Non, la macro doit ouvrir les fichiers un à un pour en extraire
le code. Tous les fichiers Excel dont le projet VBA est protégé
par mot de passe sont inaccessibles par la macro. À chaque
classeur que la macro va rencontrer tu auras un message te
spécifiant le nom du classeur qu'elle ne peut pas copier le code.

Si tu lances la macro, telle qu'elle est écrite, l'exécution de cel le-ci
pourrait prendre un bon moment (quelques minutes) car avant d'ouvrir
chacun des classeurs, elle doit scanner chacun des lecteurs pour extrai re
la liste des fichiers Excel que le lecteur possède.

Chaque fichier texte est baptisé du nom du fichier Excel dont les mac ros
proviennent.... j'espère que tu n'as pas de doublons dans les noms de
tes fichiers Excel sinon il faudra modifier légèrement comment la p rocédure
nomme les fichiers texte.

"Christophe" a écrit dans le message de news:


Bonjour Michel:

Merci mille fois pour le post. Est-ce que tu peux confirmer que dans
ce cas les macros peuvent être identifiées sans que les fichiers
Excel soient ouverts?
J'obtiens une Compile error: "User-defined type not defined" au niveau
de la ligne/bloc Dim Comp As VBComponent, Temp As String

Remerciements et sinceres salutations.

Christophe

On Jan 24, 6:52 pm, "MichDenis" wrote:

Voici une procédure qui copie dans un fichier texte toutes
les macros de chacun des fichiers des lecteurs C:, D: et J

Chaque fichier texte est créé dans le répertoire "c:Denis"
la macro se charge de créer ce répertoire si il n'existe pas.

Dans chaque fichier texte, on retrouve en haut,
le nom et le chemin complet du fichier.xls d'où provient
le code. De même, chaque module d'où provient le code
est identifié ... il est suivi du code qui lui appartient.

Attention, le code risque d'être longuet si la procédure doit fai re
une recherche sur la totalité des lecteurs. Pour ce faire, tu peux
mettre à true ou à false cette ligne de code :
.SearchSubFolders = False dans la procédure Test

Comme ce code n'a pas été testé à fond, il est toujours
possible qu'il y ait des petits pépins !!! ;-)

'----------------------------------------------------
Sub test11()
Dim X As Integer, A As Integer
Dim Chemin As String

' Où sera copié le code de chaque ficnier
'chaque fichier aura un fichier texte si
'code trouvé dans ce répertoire
Chemin = "c:Denis"
Application.ScreenUpdating = False
For Each elt In Array("c:", "D:" , "J:")
With Application.FileSearch
.NewSearch
.LookIn = elt
.FileName = "*.xls"
.SearchSubFolders = True
If .Execute > 0 Then
X = .FoundFiles.Count
For A = 1 To X
If .FoundFiles(A) <> ThisWorkbook.FullName Then
ExtraireLeCode .FoundFiles(A), Chemin
End If
Next
End If
End With
Next
End Sub
'-------------------------------------------
Sub ExtraireLeCode(Fichier As String, Chemin As String)
Dim Code As String, Wk As Workbook
Dim Comp As VBComponent, Temp As String

Application.DisplayAlerts = False
Set Wk = Workbooks.Open(Fichier)
If Wk.HasPassword Then
Wk.Password = InputBox( _
"Entrer le mot de passe pour ce fichier: " & Wk.FullName)
End If
If Wk.VBProject.Protection = vbext_pp_locked Then
MsgBox "Le code de ce fichier est protégé." & _
" Le code n'a pas été copié." & vbCrLf & vbCrLf & _
Wk.FullName, vbCritical _
+ vbOKOnly, "Attention"
Wk.Close False
Exit Sub
End If

Code = vbCrLf & Wk.FullName & vbCrLf & vbCrLf
For Each Comp In Wk.VBProject.VBComponents
With Comp.codemodule
Temp = ""
On Error Resume Next
Temp = .Lines(1, .CountOfLines)
If Err = 0 Then
Code = Code & vbCrLf
Code = Code & Comp.Name & vbCrLf & vbCrLf
Code = Code & Temp & vbCrLf
Code = Code & vbCrLf
Else
Err = 0
End If
End With
Next
If Code <> vbCrLf & Wk.FullName & vbCrLf & vbCrLf Then
EcrireCodeDansFichierTexte _
Replace(Wk.Name, ".xls", ""), Chemin, Code
End If
Wk.Close False
End Sub
'-------------------------------------------
Sub EcrireCodeDansFichierTexte(SonNom As String, _
Chemin As String, Code As String)

Dim F As Long
If Dir(Chemin, vbDirectory) = "" Then
VBA.MkDir Chemin
End If
F = FreeFile
Vers = Chemin & SonNom & ".txt"
Open Vers For Output As #F
Write #F, Code
Close #F
End Sub
'-------------------------------------------- Hide quoted text -- Sho w quoted text -- Masquer le texte des messages précédents -



- Afficher le texte des messages précédents -




Avatar
MichDenis
Tu dois cocher les 2 cases à cocher dans le bas de la fenêtre suivante :
Barre des menus de la feuille de calcul / outils / macro / sécurité / onglet : Éditeurs approuvés/



"Christophe" a écrit dans le message de news:

Michel:

J'ai testé la macro sur un autre ordinateur afin d'éviter le problème
rencontré avec les fichiers "temporaires" excel mais malheureusement
je recois le message d'erreur suivant:

Erreur d'Execution "1004"
L'acces du programme a Visual Basic n'est pas fiable.

Quand je clique sur débogage j'arrive sur la ligne suivante:
For Each Comp In Wk.VBProject.VBComponents

Merci.

Christophe
On 29 jan, 17:27, "MichDenis" wrote:
| essaie d'ouvrir des fichiers temporaires xls

De quoi ont l'air tes fichiers temporaires dans l'explorateur Windows ?
(leur orthographe)

"Christophe" a écrit dans le message de news:

Michel:

Merci. Je viens de tester ta macro qui à n'en pas douter fonction
parfaitement comme le confireme Marianne. Malheureusement pour ma part
je rencontre encore un problème (Run-time error 1004) au niveau de
Set Wk = Workbooks.Open(Fichier) dans Sub ExtraireLeCode(Fichier As
String, Chemin As String)

En fait la macro essaie d'ouvrir des fichiers temporaires xls créés
lorsque l'on ouvre par exemple un fichier excel joint dans LotusNotes
et ne les trouve pas parce qu'il s'agit de fichier temporaires qui ont
été vraissemblablement renommés ou supprimés ce qui explique le
plantage. Existe t-il un moyen de ne pas considérer les fichiers exel
que l'on ne trouve plus?

Sincères salutations.

Christophe

On Jan 25, 4:18 pm, "MichDenis" wrote:



Remplace ceci :
Dim Comp As VBComponent
Par
Dim Comp As Object

Et si tu veux garder
Dim Comp As VBComponent
tu dois déclarer la bibliothèque suivante :
"Microsoft Visual basic for application extensibility 5.3"

| Est-ce que tu peux confirmer que dans ce cas les macros
| peuvent être identifiées sans que les fichiers Excel soient
| ouverts?

Non, la macro doit ouvrir les fichiers un à un pour en extraire
le code. Tous les fichiers Excel dont le projet VBA est protégé
par mot de passe sont inaccessibles par la macro. À chaque
classeur que la macro va rencontrer tu auras un message te
spécifiant le nom du classeur qu'elle ne peut pas copier le code.

Si tu lances la macro, telle qu'elle est écrite, l'exécution de celle-ci
pourrait prendre un bon moment (quelques minutes) car avant d'ouvrir
chacun des classeurs, elle doit scanner chacun des lecteurs pour extraire
la liste des fichiers Excel que le lecteur possède.

Chaque fichier texte est baptisé du nom du fichier Excel dont les macros
proviennent.... j'espère que tu n'as pas de doublons dans les noms de
tes fichiers Excel sinon il faudra modifier légèrement comment la procédure
nomme les fichiers texte.

"Christophe" a écrit dans le message de news:


Bonjour Michel:

Merci mille fois pour le post. Est-ce que tu peux confirmer que dans
ce cas les macros peuvent être identifiées sans que les fichiers
Excel soient ouverts?
J'obtiens une Compile error: "User-defined type not defined" au niveau
de la ligne/bloc Dim Comp As VBComponent, Temp As String

Remerciements et sinceres salutations.

Christophe

On Jan 24, 6:52 pm, "MichDenis" wrote:

Voici une procédure qui copie dans un fichier texte toutes
les macros de chacun des fichiers des lecteurs C:, D: et J

Chaque fichier texte est créé dans le répertoire "c:Denis"
la macro se charge de créer ce répertoire si il n'existe pas.

Dans chaque fichier texte, on retrouve en haut,
le nom et le chemin complet du fichier.xls d'où provient
le code. De même, chaque module d'où provient le code
est identifié ... il est suivi du code qui lui appartient.

Attention, le code risque d'être longuet si la procédure doit faire
une recherche sur la totalité des lecteurs. Pour ce faire, tu peux
mettre à true ou à false cette ligne de code :
.SearchSubFolders = False dans la procédure Test

Comme ce code n'a pas été testé à fond, il est toujours
possible qu'il y ait des petits pépins !!! ;-)

'----------------------------------------------------
Sub test11()
Dim X As Integer, A As Integer
Dim Chemin As String

' Où sera copié le code de chaque ficnier
'chaque fichier aura un fichier texte si
'code trouvé dans ce répertoire
Chemin = "c:Denis"
Application.ScreenUpdating = False
For Each elt In Array("c:", "D:" , "J:")
With Application.FileSearch
.NewSearch
.LookIn = elt
.FileName = "*.xls"
.SearchSubFolders = True
If .Execute > 0 Then
X = .FoundFiles.Count
For A = 1 To X
If .FoundFiles(A) <> ThisWorkbook.FullName Then
ExtraireLeCode .FoundFiles(A), Chemin
End If
Next
End If
End With
Next
End Sub
'-------------------------------------------
Sub ExtraireLeCode(Fichier As String, Chemin As String)
Dim Code As String, Wk As Workbook
Dim Comp As VBComponent, Temp As String

Application.DisplayAlerts = False
Set Wk = Workbooks.Open(Fichier)
If Wk.HasPassword Then
Wk.Password = InputBox( _
"Entrer le mot de passe pour ce fichier: " & Wk.FullName)
End If
If Wk.VBProject.Protection = vbext_pp_locked Then
MsgBox "Le code de ce fichier est protégé." & _
" Le code n'a pas été copié." & vbCrLf & vbCrLf & _
Wk.FullName, vbCritical _
+ vbOKOnly, "Attention"
Wk.Close False
Exit Sub
End If

Code = vbCrLf & Wk.FullName & vbCrLf & vbCrLf
For Each Comp In Wk.VBProject.VBComponents
With Comp.codemodule
Temp = ""
On Error Resume Next
Temp = .Lines(1, .CountOfLines)
If Err = 0 Then
Code = Code & vbCrLf
Code = Code & Comp.Name & vbCrLf & vbCrLf
Code = Code & Temp & vbCrLf
Code = Code & vbCrLf
Else
Err = 0
End If
End With
Next
If Code <> vbCrLf & Wk.FullName & vbCrLf & vbCrLf Then
EcrireCodeDansFichierTexte _
Replace(Wk.Name, ".xls", ""), Chemin, Code
End If
Wk.Close False
End Sub
'-------------------------------------------
Sub EcrireCodeDansFichierTexte(SonNom As String, _
Chemin As String, Code As String)

Dim F As Long
If Dir(Chemin, vbDirectory) = "" Then
VBA.MkDir Chemin
End If
F = FreeFile
Vers = Chemin & SonNom & ".txt"
Open Vers For Output As #F
Write #F, Code
Close #F
End Sub
'-------------------------------------------- Hide quoted text -- Show quoted text -- Masquer
le texte des messages précédents -



- Afficher le texte des messages précédents -




Avatar
MichDenis
Pour éviter le traitement des fichiers "Temp", remplace
cette section des macros soumises par celle-ci.

La fonction Split() utilisée dans cette macro requiert excel 2000

'-----------------------------------------
Sub test11()
Dim X As Integer, A As Integer
Dim Chemin As String, Y As String

' Où sera copié le code de chaque ficnier
'chaque fichier aura un fichier texte si
'code trouvé dans ce répertoire
Chemin = "c:Denis"
Application.ScreenUpdating = False
For Each elt In Array("c:", "D:", "J:")
With Application.FileSearch
.NewSearch
.LookIn = elt
.Filename = "*.xls"
.SearchSubFolders = True
If .Execute > 0 Then
X = .FoundFiles.Count
For A = 1 To X
Y = .FoundFiles(A)
If Left(Trim(Split(Y, "")(UBound(Split(Y, "")))), 1) <> "~" Then
If Y <> ThisWorkbook.FullName Then
ExtraireLeCode Y, Chemin
End If
End If
Next
End If
End With
Next
End Sub
'-----------------------------------------





"Christophe" a écrit dans le message de news:

Merci Michel et désolé pour le peu réactivité.

Le message d'erreur exact est le suivant:
----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Microsoft Visual Basic
Run-Time error '1004':

'C:Documents and SettingsChristophe JolyLocal SettingsTemp
notes5852E6~0590896.XLS' could not be found.
Check the spelling of the file, and verify that the file location is
correct.

If you are trying toi open a file from upur list of most recently used
files on the File menu, make sure that the file has not been renamed.
----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------

Merci par avance.

Christophe



On Jan 29, 5:27 pm, "MichDenis" wrote:
| essaie d'ouvrir des fichiers temporaires xls

De quoi ont l'air tes fichiers temporaires dans l'explorateur Windows ?
(leur orthographe)

"Christophe" a écrit dans le message de news:

Michel:

Merci. Je viens de tester ta macro qui à n'en pas douter fonction
parfaitement comme le confireme Marianne. Malheureusement pour ma part
je rencontre encore un problème (Run-time error 1004) au niveau de
Set Wk = Workbooks.Open(Fichier) dans Sub ExtraireLeCode(Fichier As
String, Chemin As String)

En fait la macro essaie d'ouvrir des fichiers temporaires xls créés
lorsque l'on ouvre par exemple un fichier excel joint dans LotusNotes
et ne les trouve pas parce qu'il s'agit de fichier temporaires qui ont
été vraissemblablement renommés ou supprimés ce qui explique le
plantage. Existe t-il un moyen de ne pas considérer les fichiers exel
que l'on ne trouve plus?

Sincères salutations.

Christophe

On Jan 25, 4:18 pm, "MichDenis" wrote:



Remplace ceci :
Dim Comp As VBComponent
Par
Dim Comp As Object

Et si tu veux garder
Dim Comp As VBComponent
tu dois déclarer la bibliothèque suivante :
"Microsoft Visual basic for application extensibility 5.3"

| Est-ce que tu peux confirmer que dans ce cas les macros
| peuvent être identifiées sans que les fichiers Excel soient
| ouverts?

Non, la macro doit ouvrir les fichiers un à un pour en extraire
le code. Tous les fichiers Excel dont le projet VBA est protégé
par mot de passe sont inaccessibles par la macro. À chaque
classeur que la macro va rencontrer tu auras un message te
spécifiant le nom du classeur qu'elle ne peut pas copier le code.

Si tu lances la macro, telle qu'elle est écrite, l'exécution de celle-ci
pourrait prendre un bon moment (quelques minutes) car avant d'ouvrir
chacun des classeurs, elle doit scanner chacun des lecteurs pour extraire
la liste des fichiers Excel que le lecteur possède.

Chaque fichier texte est baptisé du nom du fichier Excel dont les macros
proviennent.... j'espère que tu n'as pas de doublons dans les noms de
tes fichiers Excel sinon il faudra modifier légèrement comment la procédure
nomme les fichiers texte.

"Christophe" a écrit dans le message de news:


Bonjour Michel:

Merci mille fois pour le post. Est-ce que tu peux confirmer que dans
ce cas les macros peuvent être identifiées sans que les fichiers
Excel soient ouverts?
J'obtiens une Compile error: "User-defined type not defined" au niveau
de la ligne/bloc Dim Comp As VBComponent, Temp As String

Remerciements et sinceres salutations.

Christophe

On Jan 24, 6:52 pm, "MichDenis" wrote:

Voici une procédure qui copie dans un fichier texte toutes
les macros de chacun des fichiers des lecteurs C:, D: et J

Chaque fichier texte est créé dans le répertoire "c:Denis"
la macro se charge de créer ce répertoire si il n'existe pas.

Dans chaque fichier texte, on retrouve en haut,
le nom et le chemin complet du fichier.xls d'où provient
le code. De même, chaque module d'où provient le code
est identifié ... il est suivi du code qui lui appartient.

Attention, le code risque d'être longuet si la procédure doit faire
une recherche sur la totalité des lecteurs. Pour ce faire, tu peux
mettre à true ou à false cette ligne de code :
.SearchSubFolders = False dans la procédure Test

Comme ce code n'a pas été testé à fond, il est toujours
possible qu'il y ait des petits pépins !!! ;-)

'----------------------------------------------------
Sub test11()
Dim X As Integer, A As Integer
Dim Chemin As String

' Où sera copié le code de chaque ficnier
'chaque fichier aura un fichier texte si
'code trouvé dans ce répertoire
Chemin = "c:Denis"
Application.ScreenUpdating = False
For Each elt In Array("c:", "D:" , "J:")
With Application.FileSearch
.NewSearch
.LookIn = elt
.FileName = "*.xls"
.SearchSubFolders = True
If .Execute > 0 Then
X = .FoundFiles.Count
For A = 1 To X
If .FoundFiles(A) <> ThisWorkbook.FullName Then
ExtraireLeCode .FoundFiles(A), Chemin
End If
Next
End If
End With
Next
End Sub
'-------------------------------------------
Sub ExtraireLeCode(Fichier As String, Chemin As String)
Dim Code As String, Wk As Workbook
Dim Comp As VBComponent, Temp As String

Application.DisplayAlerts = False
Set Wk = Workbooks.Open(Fichier)
If Wk.HasPassword Then
Wk.Password = InputBox( _
"Entrer le mot de passe pour ce fichier: " & Wk.FullName)
End If
If Wk.VBProject.Protection = vbext_pp_locked Then
MsgBox "Le code de ce fichier est protégé." & _
" Le code n'a pas été copié." & vbCrLf & vbCrLf & _
Wk.FullName, vbCritical _
+ vbOKOnly, "Attention"
Wk.Close False
Exit Sub
End If

Code = vbCrLf & Wk.FullName & vbCrLf & vbCrLf
For Each Comp In Wk.VBProject.VBComponents
With Comp.codemodule
Temp = ""
On Error Resume Next
Temp = .Lines(1, .CountOfLines)
If Err = 0 Then
Code = Code & vbCrLf
Code = Code & Comp.Name & vbCrLf & vbCrLf
Code = Code & Temp & vbCrLf
Code = Code & vbCrLf
Else
Err = 0
End If
End With
Next
If Code <> vbCrLf & Wk.FullName & vbCrLf & vbCrLf Then
EcrireCodeDansFichierTexte _
Replace(Wk.Name, ".xls", ""), Chemin, Code
End If
Wk.Close False
End Sub
'-------------------------------------------
Sub EcrireCodeDansFichierTexte(SonNom As String, _
Chemin As String, Code As String)

Dim F As Long
If Dir(Chemin, vbDirectory) = "" Then
VBA.MkDir Chemin
End If
F = FreeFile
Vers = Chemin & SonNom & ".txt"
Open Vers For Output As #F
Write #F, Code
Close #F
End Sub
'-------------------------------------------- Hide quoted text -- Show quoted text -- Hide
quoted text -



- Show quoted text -




1 2