Apliquer une macro à une liste de classeurs

[pheonix00fr]

Bonjour à tous,
j'ai crée une petite macro pour modifier une mise en forme. Mon problème est de pouvoir la faire fonctionner sur plusieur fichiers portant un début de nom similaire ex: DDE08001;DDE08002;.....
Merci d'avance.

Sub Macro2()
'
' Macro2 Macro
' Macro enregistrée le 05/11/2009 par POSTE
'
Workbooks.Open Filename:= _
"C:\Nouveau dossier\DDE080007.xls"
Range("A22:B22").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End Sub

 

[juju_69]

Re : Apliquer une macro à une liste de classeurs

Hello,

Tes fichiers sont ils ouverts ? Si oui il faut faire un fichier qui intègre ta macro et que ta macro teste chaque fichier ouvert et s'il commence par XXX alors la lancer.

Si tes fichiers sont fermés, il faut alors tester les fichiers dans le rep, les ouvrir s'ils comencent par XXX, lancer la macros les sauvegarder et les refermer.

Si tu recherches, tu devrais facilement pouvoir trouver des boucles sur fichiers (ouverts ou fermés)

By @ +

Juju

 

[CBernardT]

Re : Apliquer une macro à une liste de classeurs

Bonsoir pheonix00fr et juju_69,


Une macro qui ne devrait pas être très loin d'obtenir le résultat souhaité.

Sub MisenForme()
Dim Dossier As Object, Fichier As Object, Chemin As String
'Chemin du dossier à analyser (à adapter au besoin)
Chemin = "C:\Nouveau dossier\"
'Attribue une référence d'objet à la variable
Set Dossier = CreateObject("Scripting.FileSystemObject").GetFolder(Chemin)
Application.ScreenUpdating = False
For Each Fichier In Dossier.Files
If Right(Fichier.Name, 4) = ".xls" Then
If Left(Fichier.Name, 3) = "DDE" Then
Workbooks.Open Filename:=Fichier
With ActiveSheet.Range("A22:B22")
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
ActiveWorkbook.Save
ActiveWorkbook.Close

End If
End If
Next
End Sub

 

[pheonix00fr]

Re : Apliquer une macro à une liste de classeurs

Ok merci pour vos reponse, je test Lundi.

 

[juju_69]

Re : Apliquer une macro à une liste de classeurs

C'est sûr que si çà la boucle vient jusqu'à toi c'est encore mieux... 🙂

Merci qui, merci Bernard^^

 

[Staple1600]

Re : Apliquer une macro à une liste de classeurs

Bonsoir


Avec FileSearch

Sub appliquerFormat()
[FONT=Courier New]Dim i As Long

Application.ScreenUpdating = False

With Application.FileSearch
    .NewSearch
    [/FONT]  [FONT=Courier New][SIZE=2].LookIn = "C:\[/SIZE][/FONT][FONT=Courier New][SIZE=2]Nouveau dossier[/SIZE][/FONT][FONT=Courier New][SIZE=2]"[/SIZE]
    .FileType = msoFileTypeExcelWorkbooks
    .Filename = "DDE08*"
    
    If .Execute > 0 Then
        For i = 1 To .FoundFiles.Count
        
            With Workbooks.Open(.FoundFiles(i), 0)
                With .Sheets(1).Range("A22:B22")
                    .HorizontalAlignment = xlGeneral
                    .VerticalAlignment = xlBottom
                    .MergeCells = True
                End With
            .Save
            .Close True
            End With
            
        Next i
End If
End With

Application.ScreenUpdating = True[/FONT] 
End Sub

 

[pheonix00fr]

Re : Apliquer une macro à une liste de classeurs

Parfait, j'ai appliqué la solution de CBernardT et un resultat impec
Merci encore à tous.