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 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65
| 'Paramètre
Dim chemin_source As String
Dim chemin_cible As String
Dim classeur As Object
Dim fonction As Variant
Dim indice As Integer
Dim fs, f, fc, f_crt As Variant
Sub traitement()
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
'parcour la liste des zones de saisie des répertoires
For indice = 1 To 45
'Mise à jour des liens
If UCase(Trim(Range("A4"))) = "VRAI" Then
If UCase(Trim(Cells(8 + indice, 1))) = "VRAI" Then
chemin_source = Cells(8 + indice, 3)
If chemin_source <> "" Then
parcourir_repertoire
ElseIf chemin_source = "" Then
Cells(8 + indice, 3).Value = "non renseigné => traitement impossible"
End If
End If
'Autre que mise à jour des liens
Else
If UCase(Trim(Cells(8 + indice, 1))) = "VRAI" Then
chemin_cible = Cells(8 + indice + 1, 3)
chemin_source = Cells(8 + indice, 3)
If chemin_source <> "" And chemin_cible <> "" Then
parcourir_repertoire
Else
If chemin_source = "" Then Cells(8 + indice, 3).Value = "non renseigné => traitement impossible"
If chemin_cible = "" Then Cells(8 + indice + 1, 3).Value = "non renseigné => traitement impossible"
End If
End If
End If
Next
MsgBox ("Traitement terminé")
End Sub
Sub parcourir_repertoire()
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(chemin_source)
Set fc = f.Files
'pour chaque fichier du répertoire, on applique les procédures ci-dessous
For Each f_crt In fc
'filtre uniquement les fichiers excel
If f_crt.Type = "Microsoft Excel Worksheet" Then
ouverture_fichier
mise_en_forme
fermeture_fichier
End If
Next
End Sub |
Partager