Bonjour,
La macro ci-dessous communiquée par MichDenis est tres bien!
Je souhairterais empécher l'ouverture d'une macro auto open.
Avez-vous une idée sur la modif. à y apporter?
En vour remerciant d'avance,
Marianne
__________________________________________________
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 = "l:\test\"
Application.ScreenUpdating = False
For Each elt In Array("l:\", "p:\")
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
'-------------------
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
MichDenis
Pourquoi utilises-tu une macro Auto open si tu ne désires pas qu'elle s'exécute à l'ouverture ? Dans quelles conditions ta macro auto open doit s'exécuter ou pas ?
Sinon tu n'as qu'à modifier son nom !
"marianne puget" a écrit dans le message de news:
Bonjour, La macro ci-dessous communiquée par MichDenis est tres bien! Je souhairterais empécher l'ouverture d'une macro auto open. Avez-vous une idée sur la modif. à y apporter? En vour remerciant d'avance, Marianne __________________________________________________ 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 = "l:test" Application.ScreenUpdating = False For Each elt In Array("l:", "p:") 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 '-------------------
Pourquoi utilises-tu une macro Auto open si tu ne désires pas
qu'elle s'exécute à l'ouverture ?
Dans quelles conditions ta macro auto open doit s'exécuter ou pas ?
Sinon tu n'as qu'à modifier son nom !
"marianne puget" <puget.marianne@neuf.fr> a écrit dans le message de news:
uchpFMWQHHA.1200@TK2MSFTNGP04.phx.gbl...
Bonjour,
La macro ci-dessous communiquée par MichDenis est tres bien!
Je souhairterais empécher l'ouverture d'une macro auto open.
Avez-vous une idée sur la modif. à y apporter?
En vour remerciant d'avance,
Marianne
__________________________________________________
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 = "l:test"
Application.ScreenUpdating = False
For Each elt In Array("l:", "p:")
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
'-------------------
Pourquoi utilises-tu une macro Auto open si tu ne désires pas qu'elle s'exécute à l'ouverture ? Dans quelles conditions ta macro auto open doit s'exécuter ou pas ?
Sinon tu n'as qu'à modifier son nom !
"marianne puget" a écrit dans le message de news:
Bonjour, La macro ci-dessous communiquée par MichDenis est tres bien! Je souhairterais empécher l'ouverture d'une macro auto open. Avez-vous une idée sur la modif. à y apporter? En vour remerciant d'avance, Marianne __________________________________________________ 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 = "l:test" Application.ScreenUpdating = False For Each elt In Array("l:", "p:") 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 '-------------------
marianne puget
Je souhaite conserver les macro auto open . elles demarrent dès que l'on clic sur le fichier J'en ai un nombre conséquent, pas identifiables dans le nom sauvegardé Ta routine est parfaite pour la gestion de mes modules actifs.Pour gagner du temps, j'aurais voulu ne pas activer ces macros.
"MichDenis" a écrit dans le message de news:
Pourquoi utilises-tu une macro Auto open si tu ne désires pas qu'elle s'exécute à l'ouverture ? Dans quelles conditions ta macro auto open doit s'exécuter ou pas ?
Sinon tu n'as qu'à modifier son nom !
"marianne puget" a écrit dans le message de news:
Bonjour, La macro ci-dessous communiquée par MichDenis est tres bien! Je souhairterais empécher l'ouverture d'une macro auto open. Avez-vous une idée sur la modif. à y apporter? En vour remerciant d'avance, Marianne __________________________________________________ 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 = "l:test" Application.ScreenUpdating = False For Each elt In Array("l:", "p:") 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 '-------------------
Je souhaite conserver les macro auto open .
elles demarrent dès que l'on clic sur le fichier
J'en ai un nombre conséquent, pas identifiables dans le nom sauvegardé
Ta routine est parfaite pour la gestion de mes modules actifs.Pour gagner du
temps, j'aurais voulu ne pas activer ces macros.
"MichDenis" <michdenis@hotmail.com> a écrit dans le message de news:
eB3GQQWQHHA.2172@TK2MSFTNGP04.phx.gbl...
Pourquoi utilises-tu une macro Auto open si tu ne désires pas
qu'elle s'exécute à l'ouverture ?
Dans quelles conditions ta macro auto open doit s'exécuter ou pas ?
Sinon tu n'as qu'à modifier son nom !
"marianne puget" <puget.marianne@neuf.fr> a écrit dans le message de news:
uchpFMWQHHA.1200@TK2MSFTNGP04.phx.gbl...
Bonjour,
La macro ci-dessous communiquée par MichDenis est tres bien!
Je souhairterais empécher l'ouverture d'une macro auto open.
Avez-vous une idée sur la modif. à y apporter?
En vour remerciant d'avance,
Marianne
__________________________________________________
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 = "l:test"
Application.ScreenUpdating = False
For Each elt In Array("l:", "p:")
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
'-------------------
Je souhaite conserver les macro auto open . elles demarrent dès que l'on clic sur le fichier J'en ai un nombre conséquent, pas identifiables dans le nom sauvegardé Ta routine est parfaite pour la gestion de mes modules actifs.Pour gagner du temps, j'aurais voulu ne pas activer ces macros.
"MichDenis" a écrit dans le message de news:
Pourquoi utilises-tu une macro Auto open si tu ne désires pas qu'elle s'exécute à l'ouverture ? Dans quelles conditions ta macro auto open doit s'exécuter ou pas ?
Sinon tu n'as qu'à modifier son nom !
"marianne puget" a écrit dans le message de news:
Bonjour, La macro ci-dessous communiquée par MichDenis est tres bien! Je souhairterais empécher l'ouverture d'une macro auto open. Avez-vous une idée sur la modif. à y apporter? En vour remerciant d'avance, Marianne __________________________________________________ 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 = "l:test" Application.ScreenUpdating = False For Each elt In Array("l:", "p:") 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 '-------------------
MichDenis
si tu as une version Excel 2002 ou plus récent,
Modifie cette ligne de code appartenant à la procédure : Sub ExtraireLeCode(Fichier As String, Chemin As String)
Set Wk = Workbooks.Open(Fichier)
Par Application.EnableEvents = False Set Wk = Workbooks.Open(Fichier) Application.EnableEvents = true
Et si tu préfères, tu peux placer cette ligne de code au début de la procédure "Sub test11" : Application.EnableEvents = False et celle-ci à la fin de la procédure : Application.EnableEvents = true
Si ta version est plus agée, tu peux utiliser ces 2 lignes de code
SendKeys "{Tab}" & "{Enter}" Set Wk = Workbooks.Open(Fichier)
Mais il faudra alors exécuter la macro à partir de l'interface de la feuille de calcul et non cellle de VBA.
"marianne puget" a écrit dans le message de news:
Je souhaite conserver les macro auto open . elles demarrent dès que l'on clic sur le fichier J'en ai un nombre conséquent, pas identifiables dans le nom sauvegardé Ta routine est parfaite pour la gestion de mes modules actifs.Pour gagner du temps, j'aurais voulu ne pas activer ces macros.
"MichDenis" a écrit dans le message de news:
Pourquoi utilises-tu une macro Auto open si tu ne désires pas qu'elle s'exécute à l'ouverture ? Dans quelles conditions ta macro auto open doit s'exécuter ou pas ?
Sinon tu n'as qu'à modifier son nom !
"marianne puget" a écrit dans le message de news:
Bonjour, La macro ci-dessous communiquée par MichDenis est tres bien! Je souhairterais empécher l'ouverture d'une macro auto open. Avez-vous une idée sur la modif. à y apporter? En vour remerciant d'avance, Marianne __________________________________________________ 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 = "l:test" Application.ScreenUpdating = False For Each elt In Array("l:", "p:") 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 '-------------------
si tu as une version Excel 2002 ou plus récent,
Modifie cette ligne de code appartenant à la procédure :
Sub ExtraireLeCode(Fichier As String, Chemin As String)
Set Wk = Workbooks.Open(Fichier)
Par
Application.EnableEvents = False
Set Wk = Workbooks.Open(Fichier)
Application.EnableEvents = true
Et si tu préfères, tu peux placer cette ligne de code
au début de la procédure "Sub test11" :
Application.EnableEvents = False
et celle-ci à la fin de la procédure :
Application.EnableEvents = true
Si ta version est plus agée, tu peux utiliser ces 2 lignes de code
SendKeys "{Tab}" & "{Enter}"
Set Wk = Workbooks.Open(Fichier)
Mais il faudra alors exécuter la macro à partir de l'interface de la feuille
de calcul et non cellle de VBA.
"marianne puget" <puget.marianne@neuf.fr> a écrit dans le message de news:
eCP81hWQHHA.4736@TK2MSFTNGP02.phx.gbl...
Je souhaite conserver les macro auto open .
elles demarrent dès que l'on clic sur le fichier
J'en ai un nombre conséquent, pas identifiables dans le nom sauvegardé
Ta routine est parfaite pour la gestion de mes modules actifs.Pour gagner du
temps, j'aurais voulu ne pas activer ces macros.
"MichDenis" <michdenis@hotmail.com> a écrit dans le message de news:
eB3GQQWQHHA.2172@TK2MSFTNGP04.phx.gbl...
Pourquoi utilises-tu une macro Auto open si tu ne désires pas
qu'elle s'exécute à l'ouverture ?
Dans quelles conditions ta macro auto open doit s'exécuter ou pas ?
Sinon tu n'as qu'à modifier son nom !
"marianne puget" <puget.marianne@neuf.fr> a écrit dans le message de news:
uchpFMWQHHA.1200@TK2MSFTNGP04.phx.gbl...
Bonjour,
La macro ci-dessous communiquée par MichDenis est tres bien!
Je souhairterais empécher l'ouverture d'une macro auto open.
Avez-vous une idée sur la modif. à y apporter?
En vour remerciant d'avance,
Marianne
__________________________________________________
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 = "l:test"
Application.ScreenUpdating = False
For Each elt In Array("l:", "p:")
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
'-------------------
Modifie cette ligne de code appartenant à la procédure : Sub ExtraireLeCode(Fichier As String, Chemin As String)
Set Wk = Workbooks.Open(Fichier)
Par Application.EnableEvents = False Set Wk = Workbooks.Open(Fichier) Application.EnableEvents = true
Et si tu préfères, tu peux placer cette ligne de code au début de la procédure "Sub test11" : Application.EnableEvents = False et celle-ci à la fin de la procédure : Application.EnableEvents = true
Si ta version est plus agée, tu peux utiliser ces 2 lignes de code
SendKeys "{Tab}" & "{Enter}" Set Wk = Workbooks.Open(Fichier)
Mais il faudra alors exécuter la macro à partir de l'interface de la feuille de calcul et non cellle de VBA.
"marianne puget" a écrit dans le message de news:
Je souhaite conserver les macro auto open . elles demarrent dès que l'on clic sur le fichier J'en ai un nombre conséquent, pas identifiables dans le nom sauvegardé Ta routine est parfaite pour la gestion de mes modules actifs.Pour gagner du temps, j'aurais voulu ne pas activer ces macros.
"MichDenis" a écrit dans le message de news:
Pourquoi utilises-tu une macro Auto open si tu ne désires pas qu'elle s'exécute à l'ouverture ? Dans quelles conditions ta macro auto open doit s'exécuter ou pas ?
Sinon tu n'as qu'à modifier son nom !
"marianne puget" a écrit dans le message de news:
Bonjour, La macro ci-dessous communiquée par MichDenis est tres bien! Je souhairterais empécher l'ouverture d'une macro auto open. Avez-vous une idée sur la modif. à y apporter? En vour remerciant d'avance, Marianne __________________________________________________ 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 = "l:test" Application.ScreenUpdating = False For Each elt In Array("l:", "p:") 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 '-------------------
marianne puget
Chapeau l'Artiste! milles fois merçi! Marianne. "MichDenis" a écrit dans le message de news: %
si tu as une version Excel 2002 ou plus récent,
Modifie cette ligne de code appartenant à la procédure : Sub ExtraireLeCode(Fichier As String, Chemin As String)
Set Wk = Workbooks.Open(Fichier)
Par Application.EnableEvents = False Set Wk = Workbooks.Open(Fichier) Application.EnableEvents = true
Et si tu préfères, tu peux placer cette ligne de code au début de la procédure "Sub test11" : Application.EnableEvents = False et celle-ci à la fin de la procédure : Application.EnableEvents = true
Si ta version est plus agée, tu peux utiliser ces 2 lignes de code
SendKeys "{Tab}" & "{Enter}" Set Wk = Workbooks.Open(Fichier)
Mais il faudra alors exécuter la macro à partir de l'interface de la feuille de calcul et non cellle de VBA.
"marianne puget" a écrit dans le message de news:
Je souhaite conserver les macro auto open . elles demarrent dès que l'on clic sur le fichier J'en ai un nombre conséquent, pas identifiables dans le nom sauvegardé Ta routine est parfaite pour la gestion de mes modules actifs.Pour gagner du temps, j'aurais voulu ne pas activer ces macros.
"MichDenis" a écrit dans le message de news:
Pourquoi utilises-tu une macro Auto open si tu ne désires pas qu'elle s'exécute à l'ouverture ? Dans quelles conditions ta macro auto open doit s'exécuter ou pas ?
Sinon tu n'as qu'à modifier son nom !
"marianne puget" a écrit dans le message de news:
Bonjour, La macro ci-dessous communiquée par MichDenis est tres bien! Je souhairterais empécher l'ouverture d'une macro auto open. Avez-vous une idée sur la modif. à y apporter? En vour remerciant d'avance, Marianne __________________________________________________ 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 = "l:test" Application.ScreenUpdating = False For Each elt In Array("l:", "p:") 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 '-------------------
Chapeau l'Artiste!
milles fois merçi!
Marianne.
"MichDenis" <michdenis@hotmail.com> a écrit dans le message de news:
%23NITjQXQHHA.4744@TK2MSFTNGP02.phx.gbl...
si tu as une version Excel 2002 ou plus récent,
Modifie cette ligne de code appartenant à la procédure :
Sub ExtraireLeCode(Fichier As String, Chemin As String)
Set Wk = Workbooks.Open(Fichier)
Par
Application.EnableEvents = False
Set Wk = Workbooks.Open(Fichier)
Application.EnableEvents = true
Et si tu préfères, tu peux placer cette ligne de code
au début de la procédure "Sub test11" :
Application.EnableEvents = False
et celle-ci à la fin de la procédure :
Application.EnableEvents = true
Si ta version est plus agée, tu peux utiliser ces 2 lignes de code
SendKeys "{Tab}" & "{Enter}"
Set Wk = Workbooks.Open(Fichier)
Mais il faudra alors exécuter la macro à partir de l'interface de la
feuille
de calcul et non cellle de VBA.
"marianne puget" <puget.marianne@neuf.fr> a écrit dans le message de news:
eCP81hWQHHA.4736@TK2MSFTNGP02.phx.gbl...
Je souhaite conserver les macro auto open .
elles demarrent dès que l'on clic sur le fichier
J'en ai un nombre conséquent, pas identifiables dans le nom sauvegardé
Ta routine est parfaite pour la gestion de mes modules actifs.Pour gagner
du
temps, j'aurais voulu ne pas activer ces macros.
"MichDenis" <michdenis@hotmail.com> a écrit dans le message de news:
eB3GQQWQHHA.2172@TK2MSFTNGP04.phx.gbl...
Pourquoi utilises-tu une macro Auto open si tu ne désires pas
qu'elle s'exécute à l'ouverture ?
Dans quelles conditions ta macro auto open doit s'exécuter ou pas ?
Sinon tu n'as qu'à modifier son nom !
"marianne puget" <puget.marianne@neuf.fr> a écrit dans le message de
news:
uchpFMWQHHA.1200@TK2MSFTNGP04.phx.gbl...
Bonjour,
La macro ci-dessous communiquée par MichDenis est tres bien!
Je souhairterais empécher l'ouverture d'une macro auto open.
Avez-vous une idée sur la modif. à y apporter?
En vour remerciant d'avance,
Marianne
__________________________________________________
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 = "l:test"
Application.ScreenUpdating = False
For Each elt In Array("l:", "p:")
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
'-------------------
Chapeau l'Artiste! milles fois merçi! Marianne. "MichDenis" a écrit dans le message de news: %
si tu as une version Excel 2002 ou plus récent,
Modifie cette ligne de code appartenant à la procédure : Sub ExtraireLeCode(Fichier As String, Chemin As String)
Set Wk = Workbooks.Open(Fichier)
Par Application.EnableEvents = False Set Wk = Workbooks.Open(Fichier) Application.EnableEvents = true
Et si tu préfères, tu peux placer cette ligne de code au début de la procédure "Sub test11" : Application.EnableEvents = False et celle-ci à la fin de la procédure : Application.EnableEvents = true
Si ta version est plus agée, tu peux utiliser ces 2 lignes de code
SendKeys "{Tab}" & "{Enter}" Set Wk = Workbooks.Open(Fichier)
Mais il faudra alors exécuter la macro à partir de l'interface de la feuille de calcul et non cellle de VBA.
"marianne puget" a écrit dans le message de news:
Je souhaite conserver les macro auto open . elles demarrent dès que l'on clic sur le fichier J'en ai un nombre conséquent, pas identifiables dans le nom sauvegardé Ta routine est parfaite pour la gestion de mes modules actifs.Pour gagner du temps, j'aurais voulu ne pas activer ces macros.
"MichDenis" a écrit dans le message de news:
Pourquoi utilises-tu une macro Auto open si tu ne désires pas qu'elle s'exécute à l'ouverture ? Dans quelles conditions ta macro auto open doit s'exécuter ou pas ?
Sinon tu n'as qu'à modifier son nom !
"marianne puget" a écrit dans le message de news:
Bonjour, La macro ci-dessous communiquée par MichDenis est tres bien! Je souhairterais empécher l'ouverture d'une macro auto open. Avez-vous une idée sur la modif. à y apporter? En vour remerciant d'avance, Marianne __________________________________________________ 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 = "l:test" Application.ScreenUpdating = False For Each elt In Array("l:", "p:") 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 '-------------------
