exclusion du classeur actif sur une boucle qui ouvre tous les fichiers d'un dossier

jmten92

XLDnaute Nouveau
Bonsoir à tous ,

Est ce que quelqu'un a une idée de la méthode à adopter pour exclure le classeur contenant la macro d'une boucle qui ouvre tous les classeurs contenus dans un dossier ?

je pense qu'il faut mettre une condition if mais je ne sais pas ou la placer ni quelle formulation utiliser .....
un grand merci à celui qui m'orienteras ..
bonne soirée

Sub macro3()
Dim fso As Object, Dossier As Object, NomDossier, feuille As Worksheet
Dim pvtTable As Object



Dim Files As Object, File As Object, i As Integer
Set fso = CreateObject("Scripting.FileSystemObject")
NomDossier = ChoisirDossier
If NomDossier = "" Then Exit Sub
Set Dossier = fso.getfolder(NomDossier)
Set Files = Dossier.Files

If Files.Count <> 0 Then

For Each File In Files

Workbooks.Open Filename:=File

For Each feuille In Worksheets
If feuille.Name Like ("*TCD RETARD*") Then

feuille.Activate
Range("D14").Select

ActiveSheet.PivotTableWizard SourceType:=xlDatabase, SourceData:=Sheets(2).ListObjects(1)

ActiveWorkbook.RefreshAll
ActiveWorkbook.Save
ActiveWorkbook.Close

End If
Next feuille

Next File
End If



End Sub
 

Hieu

XLDnaute Impliqué
Salut,

Sanc fichier, difficile de tester ; mais à vue d'oeil, je dirai comme ça :
VB:
Dim Files As Object, File As Object, i As Integer
Set fso = CreateObject("Scripting.FileSystemObject")
NomDossier = ChoisirDossier
If NomDossier = "" Then Exit Sub
Set Dossier = fso.getfolder(NomDossier)
Set Files = Dossier.Files
nom = thisworkbook.name ' ici 

If Files.Count <> 0 Then

For Each File In Files
if not File.name  = nom then  ' ici
Workbooks.Open Filename:=File

For Each feuille In Worksheets
If feuille.Name Like ("*TCD RETARD*") Then

feuille.Activate
Range("D14").Select

ActiveSheet.PivotTableWizard SourceType:=xlDatabase, SourceData:=Sheets(2).ListObjects(1)

ActiveWorkbook.RefreshAll
ActiveWorkbook.Save
ActiveWorkbook.Close

End If
Next feuille

end if  ' ici
Next File
End If



End Sub

A tester
 

jmten92

XLDnaute Nouveau
Merci pour ta réponse, j'ai testé , ta solution se rapproche de ce que j'avais tenté auparavant mais ca ne marche pas j'obtiens le message d'erreur . le classeur ne servirait pas à grand chose car il te faudrait les autres fichiers du répertoire pour tester .....
l'erreur se produit la (surlignage jaune) - Workbooks.Open Filename:=File
upload_2016-11-20_21-35-32.png


Sub macro3()
Dim fso As Object, Dossier As Object, NomDossier, feuille As Worksheet
Dim pvtTable As Object


Dim Files As Object, File As Object, i As Integer
Set fso = CreateObject("Scripting.FileSystemObject")
NomDossier = ChoisirDossier
If NomDossier = "" Then Exit Sub
Set Dossier = fso.getfolder(NomDossier)
Set Files = Dossier.Files
nom = ThisWorkbook.Name ' ici

If Files.Count <> 0 Then

For Each File In Files
If Not File.Name = nom Then ' ici
Workbooks.Open Filename:=File

For Each feuille In Worksheets
If feuille.Name Like ("*TCD RETARD*") Then

feuille.Activate
Range("D14").Select

ActiveSheet.PivotTableWizard SourceType:=xlDatabase, SourceData:=Sheets(2).ListObjects(1)

ActiveWorkbook.RefreshAll
ActiveWorkbook.Save
ActiveWorkbook.Close

End If
Next feuille

End If ' ici
Next File
End If



End Sub

Function ChoisirDossier()
Dim objShell, objFolder, chemin, SecuriteSlash
Set objShell = CreateObject("Shell.Application")
Set objFolder = _
objShell.BrowseForFolder(&H0&, "Choisissez un répertoire", &H1&)
On Error Resume Next
chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & ""
If objFolder.Title = "Bureau" Then
chemin = "C:WindowsBureau"
End If
If objFolder.Title = "" Then
chemin = ""
End If
SecuriteSlash = InStr(objFolder.Title, ":")
If SecuriteSlash > 0 Then
chemin = Mid(objFolder.Title, SecuriteSlash - 1, 2) & ""
End If
ChoisirDossier = chemin
End Function
 

jmten92

XLDnaute Nouveau
en gros j'ai un répertoire tel que : fichier 1 - fichier2 - classeur actif - fichier 3....
Avant ton intervention la macro bloquait dès l'arrivée au classeur actif (mais ok sur les deux premiers)
Grâce à ton code, tous les fichiers sont ouverts et traités comme je le veux mais en fin de process j'obtiens le message que je t'ai collé plus haut et la ca bloque ....
je n'en comprend pas la cause ...
peut on ajouter un truc du style "on error ..."?


note : le fichier macro icare indiqué ds l'erreur = this workbook ....
 

Discussions similaires

Statistiques des forums

Discussions
312 292
Messages
2 086 856
Membres
103 401
dernier inscrit
sibfil