Option Explicit
'Déclaration du chemin
Const sPath As String = "C:\Documents and Settings\I271823\Bureau\Jean Christophe\tests"
'========================
'= Procédure principale =
'========================
Sub Main()
'# Déclaration des variables de la procédure
Dim oFso As Object
Dim oFile As Object
Dim wkbSource As Workbook
Dim oDirectory As Object
Dim wks As Worksheet
Dim i As Long 'Compteur pour décalage des lignes
'# Création des objets de scripting
Set oFso = CreateObject("Scripting.FileSystemObject")
Set oDirectory = oFso.getfolder(sPath)
'# On active la gestion d'erreur
On Error GoTo GestionErreur
'# On vérifie qu'il y a bien des fichiers dans le répertoire
If Not (oDirectory.Files.Count > 0) Then
MsgBox "Le répertoire sélectionné ne contient aucun fichier !", vbCritical + vbOKOnly, "Erreur répertoire"
Exit Sub
End If
'# Désactivation de certains paramètres pour accélerer le traitement
With Application
.ScreenUpdating = False
.DisplayAlerts = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
'# On parcours tous les fichiers du répertoire
For Each oFile In oDirectory.Files
'# Si le fichier est un fichier Excel on l'ouvre. Pas de vérification de l'objet du fichier par défaut
If Right$(oFile.Name, 4) = ".xls" Or Right$(oFile.Name, 5) = ".xlsx" Then
Workbooks.Open sPath & "\" & oFile.Name, 0 '<- 0: ne pas mettre à jour les liens externes.
Set wkbSource = ActiveWorkbook
'# On parcours les onglets du fichier.
For Each wks In wkbSource.Worksheets
'# Si le nom fait 3 caractère alors il s'agit d'un site
If Left$(wks.Name, 2) = "3." Then wks.Name = "3. Valeurs"
Next
End If
'# On ferme le fichier après récupération
wkbSource.Close SaveChanges:=False
Next
MsgBox "Les onglets des fichiers ont été modifiés avec succès.", vbOKOnly + vbInformation, "Fin Traitement"
GestionErreur:
'# On ferme les objets créés
Set oFso = Nothing
Set oDirectory = Nothing
Set wkbSource = Nothing
'# Rétablissement des paramètres Excel
With Application
.ScreenUpdating = True
.DisplayAlerts = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
.StatusBar = False
End With
End Sub