jbballeyguier
XLDnaute Nouveau
Bonjour,
j'ai créé une macro qui utilise deux fois FileSearch dans deux boucles selon le schéma suivant :
début_boucle1
recherche1
début_boucle2
recherche2
fin_boucle2
fin_boucle1
Le problème est que recherche1 et recherche2 ne regardent pas dans le même dossier. Résultat, au premier tour de boucle, la recherche marche bien. Mais dès que la première boucle commence son second tour, la macro plante, et je me rends compte que que le .LookIn est resté sur la valeur de la recherche2... donc je me demande s'il y a moyen de forcer une réinitialisation du .LookIn... ?
Voici l'intégralité de ma macro :
Merci d'avance pour vos idées
j'ai créé une macro qui utilise deux fois FileSearch dans deux boucles selon le schéma suivant :
début_boucle1
recherche1
début_boucle2
recherche2
fin_boucle2
fin_boucle1
Le problème est que recherche1 et recherche2 ne regardent pas dans le même dossier. Résultat, au premier tour de boucle, la recherche marche bien. Mais dès que la première boucle commence son second tour, la macro plante, et je me rends compte que que le .LookIn est resté sur la valeur de la recherche2... donc je me demande s'il y a moyen de forcer une réinitialisation du .LookIn... ?
Voici l'intégralité de ma macro :
Code:
Sub changenoms()
' Récupérer le nom de l'enchainement
Dim enchainement As Range
Dim adresse As String
Dim nomench As String
Dim nouveaunom As String
Dim ScanFic As Office.FileSearch
Dim ScanScn As Office.FileSearch
Dim j As Integer
Dim niveau1 As String
Dim niveau2 As String
Dim variante As String
Dim priorite As String
Dim cell_titre As String
Dim cell_niveau1 As String
Dim cell_niveau2 As String
Dim cell_priorite As String
Dim cell_oldid As String
n = 2
Set ScanFic = Application.FileSearch
With ScanFic
Chemin = (ThisWorkbook.Path & "\" & "Enchainements")
.NewSearch
.LookIn = Chemin
.SearchSubFolders = True
.FileType = msoFileTypeExcelWorkbooks
.Execute
For Each NomFic In .FoundFiles
j = 1
Workbooks.Open Filename:=NomFic, UpdateLinks:=False
Ench = CStr(NomFic)
Ench = Mid(Ench, InStrRev(NomFic, "\") + 1)
nomench = Workbooks(Ench).Sheets("CR détaillé").Range("C1").Value
ThisWorkbook.Sheets("Nomenclature").Activate
Do Until Cells(j, 6).Value = nomench
Cells(j + 1, 6).Select
j = j + 1
Loop
niveau1 = ActiveCell.Offset(0, -4).Value
niveau2 = ActiveCell.Offset(0, -3).Value
variante = ActiveCell.Offset(0, -2).Value
priorite = ActiveCell.Offset(0, -1).Value
nouveaunom = niveau1 & "_" & niveau2 & "_" & variante
If niveau2 <> "" Then
Workbooks(Ench).Activate
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & niveau1 & "\" & niveau2 & "\" & nouveaunom & ".xls"
nouveaunom = ActiveWorkbook.Name
Else
ActiveWorkbook.SaveAs ThisWorkbook.Path & niveau1 & "\" & nouveaunom & ".xls"
nouveaunom = ActiveWorkbook.Name
End If
cell_titre = Cells(n, 1).Address
cell_niveau1 = Cells(n, 2).Address
cell_niveau2 = Cells(n, 3).Address
cell_priorite = Cells(n, 4).Address
cell_oldid = Cells(n, 5).Address
' On crée le "cartouche" de métadonnées de l'enchainement dans l'entête de la fiche.
Sheets("Entête").Activate
Cells(30, 1) = niveau1
Cells(30, 2) = niveau2
Cells(30, 3) = variante
Cells(30, 4) = priorite
With Range(Cells(30, 1), Cells(30, 7))
.Interior.ColorIndex = 1
.Font.ColorIndex = 36
.Font.Bold = True
.Borders.ColorIndex = 2
End With
Workbooks(nouveaunom).Sheets("CR détaillé").Activate
m = 1
Do While Cells(m, 8).Value <> "FIN"
'If Cells(m, 8) <> "" Then
Cells(m, 8).Select
domainefiche = ActiveCell.Value
domainefiche = Mid(domainefiche, 5, 3)
domainefiche = ThisWorkbook.Path & "\" & "Fiches" & "\" & domainefiche & "\" & "01_Finalisée"
' On recherche les fichiers dans l'arborescence et on les ouvre
Set ScanScn = Application.FileSearch
With ScanScn
.NewSearch
.LookIn = domainefiche
.SearchSubFolders = True
.FileType = msoFileTypeWordDocuments
.Execute
Dim FicheScenario As String
Dim IdFiche As String
For Each NomScn In .FoundFiles
FicheScenario = ActiveCell.Value
IdFiche = Mid(NomScn, InStrRev(NomScn, "\") + 1)
IdFiche = Mid(IdFiche, 1, 11)
If FicheScenario = IdFiche Then
ActiveSheet.Hyperlinks.Add Anchor:=selection, Address:= _
NomScn, TextToDisplay:=FicheScenario
End If
Next
End With
'End If
m = m + 1
Loop
'On ajoute les références de l'enchainement dans la table d'enchainements
ThisWorkbook.Activate
Sheets("Table_Ench").Activate
Range(cell_titre) = Workbooks(nouveaunom).Sheets("Entête").Cells(1, 2)
Range(cell_niveau1) = niveau1
Range(cell_niveau2) = niveau2
Range(cell_priorite) = priorite
Range(cell_oldid) = nomench
n = n + 1
Workbooks(nouveaunom).Close savechanges:=True
ThisWorkbook.Activate
Next
End With
End SubMerci d'avance pour vos idées
