bonjour le forum
j'ai un petit probleme avec ma macro, je n'arrive pas a executer cette macro dans les sous dossiers "synthèses"
quelqu'un peu t il m'aider, merci d'avance
voici ma macro
Dim f
'f = "C:\Documents and Settings\Bureau\Synthèses"
With Application.FileSearch
.NewSearch
.LookIn = "C:\Documents and Settings\Bureau\Synthèses"
.Execute
'nombre de fichier trouvé ?
MsgBox .FoundFiles.Count & _
" fichier(s) trouvé(s)."
Application.EnableEvents = False
Application.AskToUpdateLinks = False
'lancement de la boucle
On Error Resume Next
For Each f In .FoundFiles
Workbooks.Open FileName:=f
Application.To_UpdateLinks = 3
' début de la macro
Sheets("RESULTAT").Visible = True
Sheets("RESULTAT").Select
Range("B1:G1").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=$AC$1:$AC$52"
.IgnoreBlank = True
.InCellDropdown = False
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="95"
Sheets("RESULTAT").Visible = False
ActiveWorkbook.Save
ActiveWorkbook.Close
'fin de la macro
Next f
End With
'Message = "La MAJ a été effectuée avec succés"
End Sub
fabio
j'ai un petit probleme avec ma macro, je n'arrive pas a executer cette macro dans les sous dossiers "synthèses"
quelqu'un peu t il m'aider, merci d'avance
voici ma macro
Dim f
'f = "C:\Documents and Settings\Bureau\Synthèses"
With Application.FileSearch
.NewSearch
.LookIn = "C:\Documents and Settings\Bureau\Synthèses"
.Execute
'nombre de fichier trouvé ?
MsgBox .FoundFiles.Count & _
" fichier(s) trouvé(s)."
Application.EnableEvents = False
Application.AskToUpdateLinks = False
'lancement de la boucle
On Error Resume Next
For Each f In .FoundFiles
Workbooks.Open FileName:=f
Application.To_UpdateLinks = 3
' début de la macro
Sheets("RESULTAT").Visible = True
Sheets("RESULTAT").Select
Range("B1:G1").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=$AC$1:$AC$52"
.IgnoreBlank = True
.InCellDropdown = False
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="95"
Sheets("RESULTAT").Visible = False
ActiveWorkbook.Save
ActiveWorkbook.Close
'fin de la macro
Next f
End With
'Message = "La MAJ a été effectuée avec succés"
End Sub
fabio