Boucle sur chemin variable : si classeur existe alors test si feuil existe
Bonjour le forum !
Je bloque depuis un bon moment sur ce test que je dois effectuer.
Je dois vérifier si des classeurs avec chemin variable mais connue existe. Puis vérifier les feuilles si le classeur existe.
Pour la vérification de la présence du classeur cela fonctionne. Pour la feuille, j'ai systématiquement un retour négatif.
Voici comment je procède :
Dans le classeur "Récup donnée" en PJ :
Colonne B : le chemin fixe de tous les classeurs (dans le cas présent il s'adapte seul avec une formule)
Colonne C : un chemin variable (des sous dossiers). Les classeurs sont classés dans différents dossiers.
Colonne D : le nom du classeur à tester.
Colonne E : le nom de la feuille à tester.
Colonne F : le résultat, le classeur existe ou pas
Colonne G : le résultat, la feuille existe ou pas. (Bien évidement je prends un raccourci, si le classeur n’existe pas je saute l'étape de vérification de la feuille)
A côté, encore en PJ, 3 classeurs qu'il faut classer dans 3 dossiers :
-le classeur1 dans un dossier nommé "AAA"
-le classeur2 dans un dossier nommé "BBB"
-le classeur3 dans un dossier nommé "CCC"
L'arborescence doit donc ressembler à ceci :
Je m'y prends mal ?
J'ai bien tenté plusieurs méthodes trouvées sur le net mais je ne m'en sors pas.
Un petit coup de pouce ?
bonjour,
une proposition (pour vérifier si une feuille existe dans un classeur, il faut ouvrir le classeur)
Option Explicit
Sub VerifierClasseurEtFeuilleExiste()
Application.ScreenUpdating = False
Sheets("Feuil1").Range("F2:G9").ClearContents
Dim OL As Worksheet
Dim TV As Variant
Dim MonFichier As String
Dim MaFeuille As Object, wb As Object
Dim repertoire As String, classeur As String, chemin As String, feuille As String, nf As String
Dim i As Long
Set OL = Worksheets("Feuil1") 'définit l'onglet OL
TV = OL.Range("C2").CurrentRegion 'définit le tableau des valeurs TV
chemin = OL.Cells(2, "B")
For i = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
If OL.Cells(i, "C").Value = "" Then
Exit Sub
Else
repertoire = OL.Cells(i, "C")
classeur = OL.Cells(i, "D")
feuille = OL.Cells(i, "E")
nf = chemin & repertoire & "\" & classeur & ".xlsm"
MonFichier = Dir(nf)
If MonFichier <> "" Then
OL.Cells(i, "F").Value = "Le classeur existe"
Set wb = Workbooks.Open(nf)
On Error Resume Next
Set MaFeuille = Nothing
Set MaFeuille = wb.Sheets(feuille)
On Error GoTo 0
If MaFeuille Is Nothing Then
OL.Cells(i, "G").Value = "La feuille n'existe pas"
Else
OL.Cells(i, "G").Value = "La feuille existe"
End If
Else
OL.Cells(i, "F").Value = "Le classeur n'existe pas"
OL.Cells(i, "G").Value = "La feuille n'existe pas"
End If
End If
wb.Close False
Next i
End Subh2so4 merci...
Je vais tester tout cela dans mon classeur mais visiblement cela fonctionne.
Bonjour h2so4, bonjour le Forum,
Je viens de tester, cela fonctionne.
J'ai déplacé la ligne wb.Close False comme ceci :
If MaFeuille Is Nothing Then
OL.Cells(i, "G").Value = "La feuille n'existe pas"
Else
OL.Cells(i, "G").Value = "La feuille existe"
End If
Next y
'''''''''''''''''''DEPLACEMENT'''''''''''''''''
wb.Close False
'''''''''''''''''''DEPLACEMENT'''''''''''''''''
Else
OL.Cells(i, "F").Value = "Le classeur n'existe pas"
OL.Cells(i, "G").Value = "La feuille n'existe pas"
End If
End If
Next iSans ceci, si il manque une feuille dans un classeur, alors celui ci reste ouvert.
Bréf tout marche.
Avec ce fonctionnement, il ouvre puis referme les classeur ligne par ligne.
Je me posais une question : pendant qu'un classeur est ouvert, ne peut-on pas tester toute les feuilles?
J'ai tenté de faire une boucle dans la boucle comme ceci mais cela ne fonctionne pas :
Option Explicit
Sub VerifierClasseurEtFeuil111leExiste()
Application.ScreenUpdating = False
Sheets("Feuil1").Range("F2:G9").ClearContents
Dim OL As Worksheet
Dim TV As Variant
Dim TV2 As Variant
Dim MonFichier As String
Dim MaFeuille As Object, wb As Object
Dim repertoire As String, classeur As String, chemin As String, feuille As String, nf As String
Dim i As Long
Dim y As Long
Set OL = Worksheets("Feuil1") 'définit l'onglet OL
TV = OL.Range("C2").CurrentRegion 'définit le tableau des valeurs TV
TV2 = OL.Range("E2").CurrentRegion 'définit le tableau des valeurs TV2
chemin = OL.Cells(2, "B")
For i = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
If OL.Cells(i, "C").Value = "" Then
Exit Sub
Else
repertoire = OL.Cells(i, "C")
classeur = OL.Cells(i, "D")
'feuille = OL.Cells(y, "E")
nf = chemin & repertoire & "\" & classeur & ".xlsm"
MonFichier = Dir(nf)
If MonFichier <> "" Then
OL.Cells(i, "F").Value = "Le classeur existe"
Set wb = Workbooks.Open(nf)
On Error Resume Next
Set MaFeuille = Nothing
Set MaFeuille = wb.Sheets(feuille)
On Error GoTo 0
For y = 1 To UBound(TV2, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
feuille = OL.Cells(y, "E")
If MaFeuille Is Nothing Then
OL.Cells(i, "G").Value = "La feuille n'existe pas"
Else
OL.Cells(i, "G").Value = "La feuille existe"
End If
Next y
wb.Close False
Else
OL.Cells(i, "F").Value = "Le classeur n'existe pas"
OL.Cells(i, "G").Value = "La feuille n'existe pas"
End If
End If
Next i
End SubC'est possible?
bonjour,
oui ,c'est possible tu as mis le controle de l'existence de la feuille au mauvais endroit.
Option Explicit
Sub VerifierClasseurEtFeuil111leExiste()
'vérifie l'existence des classeurs dans un répertoire et l'existence de feuilles dans le classeur
' le tableau doit être trié sur répertoire et nom de classeur
Application.ScreenUpdating = False
Sheets("Feuil1").Range("F2:G9").ClearContents
Dim OL As Worksheet
Dim MonFichier As String
Dim MaFeuille As Object, wb As Object
Dim repertoire As String, classeur As String, chemin As String, feuille As String, nf As String
Dim i As Long
Dim y As Long
Dim dl As Long
Set OL = Worksheets("Feuil1") 'définit l'onglet OL
dl = OL.Cells(Rows.CountLarge, 3).End(xlUp).Row
'tri croissant sur chemin variable et nom classeur
OL.Range("c1").Resize(dl, 5).Sort key1:=OL.Range("c1"), order1:=xlAscending, key2:=OL.Range("D1"), order2:=xlAscending, Header:=xlYes
chemin = OL.Cells(2, "B")
For i = 2 To dl 'boucle sur toutes les lignes
If OL.Cells(i, "G") = "" Then
If OL.Cells(i, "C").Value = "" Then
Exit Sub
Else
repertoire = OL.Cells(i, "C")
classeur = OL.Cells(i, "D")
nf = chemin & repertoire & "\" & classeur & ".xlsm"
MonFichier = Dir(nf)
If MonFichier <> "" Then
Set wb = Workbooks.Open(nf)
For y = i To dl 'boucle sur toutes les lignes à partir de la ligne en cours
If classeur = OL.Cells(y, "D") And repertoire = OL.Cells(y, "C") Then 'on prend les lignes qui correspondent au classeur ouvert
OL.Cells(y, "F").Value = "Le classeur existe"
feuille = OL.Cells(y, "E")
'contrôle d'existence de la feuille
On Error Resume Next 'si erreur vba on passe à la ligne suivante
Set MaFeuille = Nothing 'par défaut la feuille n'existe pas
Set MaFeuille = wb.Sheets(feuille) 'si feuille n'existe cela produit une erreur vba, mais on passe à la ligne suivante
On Error GoTo 0 'si à partir d'ici on rencontre à nouveau une erreur on laisse VBA interrompre la macro (erreur non prévue)
If MaFeuille Is Nothing Then
OL.Cells(y, "G").Value = "La feuille n'existe pas"
Else
OL.Cells(y, "G").Value = "La feuille existe"
End If
Else
Exit For
End If
Next y
wb.Close False
Else
OL.Cells(i, "F").Value = "Le classeur n'existe pas"
OL.Cells(i, "G").Value = "La feuille n'existe pas"
End If
End If
End If
Next i
End SubC'est beau...
Le process en deviens beaucoup plus rapide.
Sans grande surprise (sauf pour moi), cela fonctionne du premiers coup.
Souvent je bloque, je tente de trouver par moi même, après plusieurs heures je pose une question.
Quand je voie la qualité de la réponse, je reste impressionné.
Merci...