Samferrir72
XLDnaute Nouveau
Bonjour,
J'ai une macro dans un fichier excel 2007 qui ne fonctionne pas car la fonction With Application.FileSearch (fonction permettant de lister des fichiers) n'est pas disponible.
Principe de la macro :
- Des fichiers excel sont stockés sur un serveur dans un répertoire défini.
- La macro vient chercher les différents fichiers (suivant le chemin présent dans la cellule B5 du fichier excel), ouvre les fichiers et reportent de manière dynamique, ligne par ligne les informations présentes dans ces fichiers au sein d'un tableau de suivi.
Comment feriez vous pour l'adapter sans tout casser : macro ci dessous:
Les paramètres d'importation des données présents dans les fichiers sont décrits dans un autre module.
Option Explicit
' Nom des fichiers à prendre en compte (exemple : FA*.XLS)
Public Const cmstrNomFichierAno As String = "FA*.xls"
' Nb de lignes dans Excel
Private Const cmintNbMaxRow As Long = 65536
' Indice de la première ligne pour les fiches
Private Const cmint1ereLigneRow As Integer = 9
' Coordonnées de la cellule ou trouver le répertoire
Private Const cmintPathRow As Integer = 5
Private Const cmintPathCol As Integer = 2
' Coordonnées de la cellule ou inscrire la date de maj
Private Const cmintMajRow As Integer = 4
Private Const cmintMajCol As Integer = 5
Public Sub Miseajour()
Dim mshtMainSheet As Worksheet ' feuille principale
Dim i As Integer
' Mémorise la feuille principale
Set mshtMainSheet = ActiveSheet
' Initialisation
mshtMainSheet.Cells(cmintMajRow, cmintMajCol).Value = "Mise à jours en cours..."
Application.ScreenUpdating = False
mshtMainSheet.Rows(cmint1ereLigneRow & ":" & cmintNbMaxRow).Delete Shift:=xlUp ' Suppression des lignes
' permet de conserver le chemin absolue du répertoire des fiches anomalies
'permet de faire la liste des fichiers du répertoire des fiches anomalies
With Application.FileSearch
.LookIn = mshtMainSheet.Cells(cmintPathRow, cmintPathCol)
.Filename = cmstrNomFichierAno ' structure des noms des fiches anomalies doit être FAxxx permettra de lister toutes les fiches sans prendre en compte les fichiers annexes
If .Execute(SortBy:=msoSortByFileName, SortOrder:=msoSortOrderAscending) > 0 Then
For i = 1 To .FoundFiles.Count
' Informe l'utilisateur de l'avancée
Application.StatusBar = "Vérification en cours... " _
& Format(i * 100 / (.FoundFiles.Count + 1), "##0") & " %"
'Appel de procédure de remplissage du tableau mémoire
Call RempliTableau(.FoundFiles(i), mshtMainSheet.Rows(i + cmint1ereLigneRow - 1))
Next i
Application.StatusBar = ""
Else
MsgBox "Il n'y a pas de fiches anomalies dans le répertoire indiqué"
End If
End With
mshtMainSheet.Cells(cmintMajRow, cmintMajCol).Value = "MAJ le " & Date & " " & Time & " !"
Application.ScreenUpdating = True
Concatener
End Sub
J'ai une macro dans un fichier excel 2007 qui ne fonctionne pas car la fonction With Application.FileSearch (fonction permettant de lister des fichiers) n'est pas disponible.
Principe de la macro :
- Des fichiers excel sont stockés sur un serveur dans un répertoire défini.
- La macro vient chercher les différents fichiers (suivant le chemin présent dans la cellule B5 du fichier excel), ouvre les fichiers et reportent de manière dynamique, ligne par ligne les informations présentes dans ces fichiers au sein d'un tableau de suivi.
Comment feriez vous pour l'adapter sans tout casser : macro ci dessous:
Les paramètres d'importation des données présents dans les fichiers sont décrits dans un autre module.
Option Explicit
' Nom des fichiers à prendre en compte (exemple : FA*.XLS)
Public Const cmstrNomFichierAno As String = "FA*.xls"
' Nb de lignes dans Excel
Private Const cmintNbMaxRow As Long = 65536
' Indice de la première ligne pour les fiches
Private Const cmint1ereLigneRow As Integer = 9
' Coordonnées de la cellule ou trouver le répertoire
Private Const cmintPathRow As Integer = 5
Private Const cmintPathCol As Integer = 2
' Coordonnées de la cellule ou inscrire la date de maj
Private Const cmintMajRow As Integer = 4
Private Const cmintMajCol As Integer = 5
Public Sub Miseajour()
Dim mshtMainSheet As Worksheet ' feuille principale
Dim i As Integer
' Mémorise la feuille principale
Set mshtMainSheet = ActiveSheet
' Initialisation
mshtMainSheet.Cells(cmintMajRow, cmintMajCol).Value = "Mise à jours en cours..."
Application.ScreenUpdating = False
mshtMainSheet.Rows(cmint1ereLigneRow & ":" & cmintNbMaxRow).Delete Shift:=xlUp ' Suppression des lignes
' permet de conserver le chemin absolue du répertoire des fiches anomalies
'permet de faire la liste des fichiers du répertoire des fiches anomalies
With Application.FileSearch
.LookIn = mshtMainSheet.Cells(cmintPathRow, cmintPathCol)
.Filename = cmstrNomFichierAno ' structure des noms des fiches anomalies doit être FAxxx permettra de lister toutes les fiches sans prendre en compte les fichiers annexes
If .Execute(SortBy:=msoSortByFileName, SortOrder:=msoSortOrderAscending) > 0 Then
For i = 1 To .FoundFiles.Count
' Informe l'utilisateur de l'avancée
Application.StatusBar = "Vérification en cours... " _
& Format(i * 100 / (.FoundFiles.Count + 1), "##0") & " %"
'Appel de procédure de remplissage du tableau mémoire
Call RempliTableau(.FoundFiles(i), mshtMainSheet.Rows(i + cmint1ereLigneRow - 1))
Next i
Application.StatusBar = ""
Else
MsgBox "Il n'y a pas de fiches anomalies dans le répertoire indiqué"
End If
End With
mshtMainSheet.Cells(cmintMajRow, cmintMajCol).Value = "MAJ le " & Date & " " & Time & " !"
Application.ScreenUpdating = True
Concatener
End Sub