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 -