Discussion :

[crissc]

Bonjour,

Je cherche à faire fonctionner un boucle multiple (sub - for - If then - if then - if then - Exit sub - end if - end if - end if - next - end sub).
Concrètement, voici ce que j'attends de mon code:

• scan un dossier (boucle For sur tous les fichiers dans le dossier)
• vérifie la structure du chemin (if Ubound = 5) et si la condition est vérifiée
• récupère le nom du chemin et traite ce nom (ajoute des données dans Liste_1)
• récupère le nom du fichier et traite ce nom:

• décompose le nom
• contrôle la condition sur l'existence de "Codes" (if colourscode... sortcode = true) et si la condition est vérifiée
• récupère certains caractères du nom pour rechercher dans un tableau (Liste_2) une correspondance (cela se fait dans une Function annexe)

• si la Function renvoie correspondance <> "Error" alors la correspondance existe et est inscrite dans Liste_1
• sinon, la correspondance n'existe pas, une information (MsgBox) est retournée à l'utilisateur (via une autre Function) et le code doit quitter la Sub

Une boucle For permet de scanner tous les sous-dossiers du dossier courant pour les mêmes opérations.

Malheureusement, Exit Sub ne quitte pas la Sub mais renvoie au dernier Next (de la boucle qui rappelle la Sub pour scanner le sous-dossier suivant - ligne 43 ci-dessous), et la Sub continue de tourner.
Voici le code très épuré :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
Sub Lit_dossier(ByRef dossier, ByRef finalFolder, ByVal niveau)
	For Each f In dossier.Files
		pathFolder = f.Path
		name = Split(pathFolder, "\")
		If UBound(name) = 5 Then
			' few treatments on name(x)
			If ColoursCode = True And TypeCode = True And SortCode = True Then
				codecolours = Mid(name(5), 1, 3)
				colourvalue = RetrieveColours
				If colourvalue <> "Error" Then
					Cells(rowVar, 6) = colourvalue
				Else
					WrongColourCode
					Exit Sub
				End If
				Cells(rowVar, 15) = codecolours
				' plus various other threatments
			ElseIf ColoursCode = True And TypeCode = True Then
				' equal type of threatment like above via RetrieveColours
			ElseIf ColoursCode = True And SortCode = True Then
				' equal type of threatment like above via RetrieveColours
			ElseIf TypeCode = True And SortCode = True Then
				' equal type of threatment like above without RetrieveColours
			ElseIf ColoursCode = True Then
				' equal type of threatment like above via RetrieveColours
			ElseIf TypeCode = True Then
				' equal type of threatment like above without RetrieveColours
			ElseIf SortCode = True Then
				' equal type of threatment like above without RetrieveColours
			Else
				' equal type of threatment like above without RetrieveColours
			End If
 
			rowVar = rowVar + 1
 
			' additional opreations with if then else endIf
			' additional opreations with if then else endIf
 
		End If
	Next
	For Each d In dossier.subfolders
		Lit_dossier d, finalFolder, niveau + 1
	Next ' Exit Sub sends to this Next but does not exit the Sub
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
 
Function RetrieveColours()
	Dim rowVar3 As Integer
 
	Worksheets("ColourCodes").Activate
	For rowVar3 = 2 To Range("A1").End(xlDown).Row
		If ActiveSheet.Cells(rowVar3, 1).Value = codecolours Then
			RetrieveColours = Sheets("ColourCodes").Cells(rowVar3, 7)
			Worksheets("Table").Select
			Exit Function
		ElseIf rowVar3 = Range("A1").End(xlDown).Row Then
			RetrieveColours = "Error"
		End If
	Next
End Function

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
 
Sub WrongColourCode()
	MsgBox ("The colours code:" & codecolours & " does not exist" & Chr(13) & "Please check and fix and restart the database generation process")
	Worksheets("ColourCodes").Select
	Cells(1, 8).Select
	With Selection
		.Value = "Wrong colour code"
		.Interior.Color = RGB(255, 0, 0)
		.Font.Size = 16
		.Columns.AutoFit
	End With
	Cells(2, 8).Select
	With Selection
		.NumberFormat = "@"
		.Value = codecolours
		.Font.Color = RGB(255, 0, 0)
	End With
End Sub

J'ai bien essayé d'inverser le test sur la condition (mettre la condition = "Error" en premier), pour le même résultat.

S'il faut un code fonctionnel pour les tests, je suis en train de le simplifier et de retirer tous les liens vers ou en provenance d'autres Sub et Function.
Merci par avance pour votre aide.

Cdlt
- crissc -

[joe.levrai]

Bonjour,

étant donné que ta procédure est récursive, ton exit sub revient simplement à quitter la procédure courante, et du coup tu reviens dans la récursion précédente.

Maintenant, il s'agit de savoir ce que tu veux Exit exactement ? l'exploration des fichiers du dossier actuel ? l'exploration des sous-dossiers du dossier actuel ? Autre chose ?

il te faut une variable boléenne de portée module (ou publique) qure tu passes à True avant ton Exit Sub + tester la valeur de ta variable à l'endroit approprié qui dépend de la réponse aux questions que j'ai posé ci-dessus

[Invité]

Bonjour,
ben évidement que ta boucle continu car comment pourait il en être autrement comment la sub appelante peut le savoir?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Function Lit_dossier(ByRef dossier, ByRef finalFolder, ByVal niveau) as booleant

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
If colourvalue <> "Error" Then
                    Cells(rowVar, 6) = colourvalue
                Else
                    WrongColourCode
Lit_dossier=true
                    Exit Function 
                End If

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
ForEach d In dossier.subfolders
        if Lit_dossier( d, finalFolder, niveau + 1 ) =true then  Lit_dossier=true : exit function
Next' Exit Sub sends to this Next but does not exit the Sub

[crissc]

Bonjour à vous deux et merci de votre aide,

J'avais déjà vu ce type de déclaration pour une fonction, mais je n'en voyais pas la portée ni l'utilité.
Naïvement je pensai qu'un Exit Sub ou Exit Function permettait de mettre fin à la Sub ou la Function complète sans présumer des fonctions de récursion .

Je cherchai comment remplacer ma sub par une fonction, mais sans maîtrise de la méthode de déclarer cette fonction comme un booléen, mes tests sont restés vains.

J'ai de quoi étudier le fonctionnement de ce type de déclaration pour une Function maintenant pour bien le maîtriser.

Cdlt
- crissc -