[Catégorie modifiée .Net -> VBA] Récupérer nom de fichier ftp en les listant

johancc89 Messages postés 3 Date d'inscription lundi 7 novembre 2011 Statut Membre Dernière intervention 9 novembre 2011 - 8 nov. 2011 à 10:28
johancc89 Messages postés 3 Date d'inscription lundi 7 novembre 2011 Statut Membre Dernière intervention 9 novembre 2011 - 9 nov. 2011 à 10:05
Bonjour,

Je vous explique mon problème : j'ai une macro qui ouvre plusieurs fichiers. Seulement, l'environnement sur lequel les fichiers sont hébergés a changé, ainsi que le nommage de ces derniers. Ils sont hébergés sur un serveur Linux. Les fichiers ont cette tête :
TOTO.form.201110281445.987654321
Mon problème porte sur la première série de chiffres qui représente la date de génération du fichier. Cette dernière n'est jamais la même et je dois faire en sorte de "sauter" ces 12 caractères pour gérer plusieurs fichiers.
Dans un premier temps, j'ai essayé cette syntaxe : TOTO.form.*.987654321
Normalement, cela devrait fonctionner, mais étant donné que mes fichiers sont sur un serveur Linux, vba prend le caractère tel quel :\
La solution serait de lister les fichiers du serveur ftp. J'ai trouvé des bouts de code, mais je n'arrive pas à les faire fonctionner

Pouvez-vous m'aider svp ?

3 réponses

cs_Jack Messages postés 14007 Date d'inscription samedi 29 décembre 2001 Statut Modérateur Dernière intervention 28 août 2015 78
8 nov. 2011 à 12:30
Salut

Si tu fais du VBA, ce n'est pas du .Net --> Catégorie modifiée
Merci d'en tenir compte pour tes prochaines questions.

"Pouvez-vous m'aider svp ?"
Oui, à condition de donner des infos (avant qu'on les demande).
Quel est ton code ?
"ça marche pas" n'a jamais décrit correctement les problèmes

"j'ai essayé cette syntaxe : TOTO.form.*.987654321"
Dans quelle commande ?
As-tu essayé cette autre syntaxe : TOTO.form.????????????.987654321

Vala
Jack, MVP VB
NB : Je ne répondrai pas aux messages privés

Le savoir est la seule matière qui s'accroit quand on la partage (Socrate)
0
johancc89 Messages postés 3 Date d'inscription lundi 7 novembre 2011 Statut Membre Dernière intervention 9 novembre 2011
8 nov. 2011 à 14:18
Merci pour ta réponse.
Oui, désolé pour la catégorie, je me suis trompé.

Je vais essayer la syntaxe que tu me proposes dès que je peux (demain matin).
Je posterai aussi le code ;)
0
johancc89 Messages postés 3 Date d'inscription lundi 7 novembre 2011 Statut Membre Dernière intervention 9 novembre 2011
9 nov. 2011 à 10:05
Bonjour,

Malheureusement, TOTO.form.????????????.987654321 ne fonctionne pas.

Voici mon code :
Sub index()

' Déclarations
Dim sLeChemin As String       'Chemin d'accès de ce classeur
Dim sFichierTravail As String  'Nom du fichier de travail
Dim bLeChoix As Boolean       'Indique si un des traitements a été sélectionné
Dim iClientEnCours As Double 'Compteur des relevés traités
Dim sNumClient As String        'N° de client
Dim erreur As Boolean       'Prend la valeur Vrai en cas de problème de chargement de fichiers
Dim Erreur_Cli As Boolean   'Erreur d'ouverture d'un relevé client
Dim Fic_Existe As String    'Nom du fichier xls du relevé
Dim Fichier_Fil As String   'Nom du fichier Excel sauvegardé
Dim Nom_Client As String    'Nom du client
Dim NomCla(10) As String    'Noms des classeurs contenant le détail des relevés à créer
Dim NbCli(10) As Double    'Nbre de relevés à créer pour chaque traitement
Dim NbTrait As Double      'Indique le nbre de traitements disponibles
Dim ligner As Double       'Ligne du client dans la feuille infos (cas MAJ)
Dim Ligne_info As Double   'Ligne du client dans la feuille infos (cas création)
Dim ligne As Double        'Ligne à utiliser dans la feuille Releves
Dim reste As Single         'Temps restant pour le traitement
Dim sText As String         'Message du progress bar
Dim sel As Double          'Compteur des traitements disponibles
Dim temps As Single         'Variable de calcul du temps restant de traitement
Dim Type_Groupement(10) As Boolean  'Indique si un traitement concerne des groupements
Dim ValeurPivot As String   'Valeur de pivot à utiliser dans la feuille de synthese
Dim vide As Boolean         'Indique si le relevé du client est vide
Dim iDerLigne As Double     'Compteur de la derniere ligne du tableau des groupements
    
Dim I As Double    'Cpt de boucle FOR

'Initialisation du Chemin d'accès de ce classeur
Let sLeChemin = ThisWorkbook.Path
Let sFichierTravail = ActiveWorkbook.Name
Le_User = UCase(InputBox _
  (Prompt:="Veuillez indiquer le user qui a executé le traitement sous BORA / LORA / NORA", _
  Title:="Relevés Excel", default:=Le_User))
  
Le_ID = UCase(InputBox _
  (Prompt:="Veuillez indiquer votre ID :", _
  Title:="Relevés Excel", default:=Le_ID))
        
'Si pas de user ou bouton annuler, on sort
If Le_User = "" Then Exit Sub
        
'Recherche du fichier de destruction des fichiers temporaires Explorer
'Fic_Existe = Dir("Z:\DEL.BAT")
Fic_Existe = Dir("D:\Documents and Settings" & Le_User & "\My Documents\DEL.BAT")
If Fic_Existe = "" Then ' Si il n'existe pas, on le créé
    'Open "Z:\DEL.BAT" For Append As #1
    Open "D:\Documents and Settings" & Le_User & "\My Documents\DEL.BAT" For Append As #1
    'Print #1, "del /Q/S ""Z:\WINDOWS\Temporary Internet Files\*.*"""
    Print #1, "del /Q/S ""D:\Documents and Settings" & Le_User & "\WINDOWS\Temporary Internet Files\*.*"""
    Close #1
End If
    
'Solution retenue car les chargement FTP sont conservés en permanence sans MAJ possible
'Donc on supprime avant pour charger ensuite
'Shell "Z:\DEL.BAT", 0 ' Lancement de la suppression des fichiers temporaires
Shell "D:\Documents and Settings" & Le_User & "\My Documents\DEL.BAT", 0
Application.ScreenUpdating = False
Application.StatusBar = "Chargement des traitements de : " & Le_User
erreur = False
    
On Error GoTo erreur_ouverture ' Si le premier fichier de relevés est introuvable
'Workbooks.OpenText Filename:=Chemin_Reseau & "RELEVE0_" & Le_User
Workbooks.OpenText Filename:=Chemin_Reseau & "/" & "LGEMIREPEX.form.*" & "." & Le_ID
'Workbooks.OpenText Filename:=Chemin_Reseau & "LGEMIREPEX.form.*." & Le_ID
On Error GoTo 0


'Nbre de relevés
NbCli(0) = ActiveWorkbook.Sheets(1).Cells(1, 1).CurrentRegion.Rows.Count - 1
'Nom du classeur
NomCla(0) = ActiveWorkbook.Name
    
'Recherche si groupement
If InStr(1, Cells(1, 1), "GROUPEMENT") > 0 _
    Then Type_Groupement(0) True Else Type_Groupement(0) False
'MAJ de la boite de dialogue
BD_Releves.Traitements.Clear
    
'Si plus d'un client dans ce traitement
If NbCli(0) > 2 Then
    BD_Releves.Traitements.AddItem Cells(1, 1) & " Multiple"
Else
    BD_Releves.Traitements.AddItem Cells(1, 1) & " " & Cells(2, 1)
End If
    
'On boucle sur les 9 autres traitements possibles
For I = 1 To 9
    'Si un fichier de relevés est introuvable
    On Error GoTo erreur_Classeur
    Workbooks.OpenText Filename:=Chemin_Reseau & "LGEMIREPEX.form.*" & "." & Le_ID
    'Workbooks.OpenText Filename:=Chemin_Reseau & "LGEMIREPEX.form.*" & Le_ID
    On Error GoTo 0
        
    ' Erreur, donc pas d'autres traitements disponibles
    If erreur = True Then Exit For
        
    'Nbre de relevés
    NbCli(I) = ActiveWorkbook.Sheets(1).Cells(1, 1).CurrentRegion.Rows.Count - 1
    'Nom du classeur
    NomCla(I) = ActiveWorkbook.Name
        
    'Recherche si groupement
    If InStr(1, Cells(1, 1), "GROUPEMENT") > 0 _
        Then Type_Groupement(I) True Else: Type_Groupement(I) False
          
    If NbCli(I) > 2 Then ' Si plus d'un client dans ce traitement
        BD_Releves.Traitements.AddItem Cells(1, 1) & " Multiple"
    Else
        BD_Releves.Traitements.AddItem Cells(1, 1) & " " & Cells(2, 1)
    End If
        
Next

'MAJ de la boite de dialogue
BD_Releves.CODE_USER = Le_User
    
'Affichage de la boite de dialogue du choix des traitements
La_Reponse = False
ThisWorkbook.Activate
Application.StatusBar = "Sélection des traitements à charger..."
Application.ScreenUpdating = True
    
'On boucle tant qu'il n'y a pas de sélection
Do
    BD_Releves.Show
    
    'On sort si sélection du bouton 'Annuler'
    If La_Reponse = False Then
        Application.StatusBar = False
            
        'On ferme tous les classeurs de relevés
        On Error Resume Next ' On ne fait rien si il n'y pas de classeur
        For I = 0 To 9
            Workbooks(NomCla(I)).Close
        Next
        Exit Sub
    End If
        
    bLeChoix = False

    'Nbre de traitements disponibles
    NbTrait = BD_Releves.Traitements.ListCount
        
    'On cherche si au moins un traitement est sélectionné
    For sel = 0 To NbTrait - 1
        If BD_Releves.Traitements.Selected(sel) True Then bLeChoix True
    Next
'Fin de boucle si sélection de traitement
Loop While bLeChoix = False
    
'On compte le nbre de relevés à traiter
For sel = 0 To NbTrait - 1
    If BD_Releves.Traitements.Selected(sel) = True Then
        Total_Cli = Total_Cli + NbCli(sel)
    End If
Next
    
'Macro d'objet progress Bar
Workbooks.Open Filename:=sLeChemin & "\WKSPRGRS.XLA"
Application.ScreenUpdating = False
temps = Timer ' Calcul du temps de traitement
    
'Corps du programme de génération des relevés
For sel = 0 To NbTrait - 1 ' Pour chaque traitement
    If BD_Releves.Traitements.Selected(sel) = True Then ' Si il est sélectionné
        
        'On boucle tant qu'il reste des relevés
        ligne = 2
        'NomCla(sel) est le nom du REPEX
        Do While Workbooks(NomCla(sel)).Sheets(1).Cells(ligne, 1) <> ""
            iClientEnCours = iClientEnCours + 1
           
            'sNumClient = Format(Workbooks(NomCla(sel)).Sheets(1).Cells(ligne, 1), "0000000")
            sNumClient = Format(Workbooks(NomCla(sel)).Sheets(1).Cells(ligne, 1), "0000000")
           ' MsgBox (sNumClient)
            
            ' Affichage de la progression du traitement
            Application.StatusBar = "Chargement du relevé client : " & sNumClient
            
            'Calcul du temps restant à partir du 5ème relevé
            If iClientEnCours > 4 Then
                reste = (Timer - temps) / iClientEnCours * (Total_Cli - iClientEnCours)
                sText = "Veuillez patienter !" & Chr(20) & _
                 "Traitement du client : " & sNumClient & Chr(10) & _
                 "Temps restant estimé : " & TimeSerial(0, 0, Int(reste))
            Else
                sText = "Veuillez patienter !" & Chr(20) & _
                 "Traitement du client : " & sNumClient
            End If
                
            'Affichage du message
            Application.Run "WKSPRGRS.XLA!ProgressShow"
            'Texte centré
            Application.Run "WKSPRGRS.XLA!ProgressSetText", sText, "C"
            '% du progress bar
            Application.Run "WKSPRGRS.XLA!ProgressSetValue", iClientEnCours, Total_Cli
            Erreur_Cli = False
                
            ' Création du relevé
            On Error GoTo err_ouverture_client
            Workbooks.OpenText Filename:=Chemin_Reseau & "LGEMICUSTEX.form.201110281446." & Le_ID & "." & sNumClient, Origin:=xlWindows, _
                StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
                ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=True, _
                Comma:=False, Space:=False, Other:=False, _
                FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 2), Array(4, 4), Array(5, 4), Array(6, 4), Array(7, 4))
                'FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 2))
                    
            On Error GoTo 0
            If Erreur_Cli = False Then ' Si il n'y a pas d'erreur, on traite le relevé
                vide = False
                If (Cells(1, 1) "FICHIER VIDE") Or (Cells(1, 1) "EMPTY FILE") Then vide = True ' Relevé vide
                If vide = False Then ' Si le relevé n'est pas vide, on le génère
                        
                    ' Mise en forme du relevé
                    '-------------------------
                    ActiveWindow.DisplayGridlines = False
                    Range(PREM_COL & PREM_LG_BLOC_CLIENT & ":" _
                     & PREM_COL & DER_LG_BLOC_CLIENT).Cut _
                     Destination:=Range(COL_NUM_MVT & PREM_LG_BLOC_CLIENT & ":" _
                     & COL_NUM_MVT & DER_LG_BLOC_CLIENT)
                    
                    Columns(PREM_COL).Delete Shift:=xlToLeft
                    Range(PREM_COL & PREM_LG_BLOC_CLIENT & ":" & PREM_COL & NOM_ETAT) _
                     .Font.Bold = True
                    Range(PREM_COL & PREM_LG_BLOC_CLIENT & ":" & DER_COL & NOM_ETAT) _
                     .Font.Size = 11
                     
                    'Mise en forme de la ligne d'entete
                    Rows(LG_ENTETE_COL).HorizontalAlignment = xlCenter
                     
                    'Mise en forme des colonnes de montant
                    Columns(COL_MT_INITIAL & ":" & DER_COL) _
                     .NumberFormat = "#,##0.00_ ;[Red]-#,##0.00 "
                    
                    ActiveSheet.PageSetup.PrintTitleRows = "$9:$9"
                    
                    With ActiveSheet.PageSetup
                        .Zoom = False
                        .RightHeader = "&P/&N"
                        .FitToPagesWide = 1
                        .FitToPagesTall = False
                    End With
                        
                    Nom_Client = Range(PREM_COL & LG_NOM_CLIENT)
                        
                    'Mise en forme des colonnes
                    Columns(COL_NUM_MVT).HorizontalAlignment = xlLeft
                    With Columns(COL_DATE_ECHEANCE)
                        .NumberFormat = "dd/mm/yy"
                        .HorizontalAlignment = xlCenter
                    End With
                    Columns(COL_DEVISE).HorizontalAlignment = xlCenter
                    With Columns(COL_DATE_TRANSACT)
                        .NumberFormat = "dd/mm/yy"
                        .HorizontalAlignment = xlCenter
                    End With
                    Columns(PREM_COL & ":" & DER_COL).Columns.AutoFit
                    Columns(PREM_COL).ColumnWidth = 8.22
                    Columns(COL_DEVISE).ColumnWidth = 7
                    
                    Range(PREM_COL & LG_NOM_CLIENT & ":" & PREM_COL & DER_LG_BLOC_CLIENT) _
                     .Cut _
                     Destination:=Range(COL_NOM_CLIENT_FIN & LG_FINALE_NOM_CLIENT & ":" _
                     & COL_NOM_CLIENT_FIN & LG_FINALE_INFO_CLIENT)
                    Rows(DER_LG_BLOC_CLIENT).Delete Shift:=xlUp
                    Range(COL_NOM_CLIENT_FIN & LG_FINALE_NOM_CLIENT).Font.FontStyle = "Gras"
                    
                    With Range(PREM_COL & LG_ENTETE_COL & ":" & DER_COL & LG_ENTETE_COL) _
                     .Borders(xlEdgeBottom)
                        .LineStyle = xlContinuous
                        .Weight = xlThin
                        .ColorIndex = xlAutomatic
                    End With
                    
                    Range(COL_MT_INITIAL & LG_ENTETE_COL & ":" & DER_COL & LG_ENTETE_COL) _
                     .HorizontalAlignment = xlRight

                    'Changement des noms de colonnes
                    '--------------------------------
                    'Quand la colonne de date d'echeance est en francais alors la changer
                    If Range(COL_DATE_ECHEANCE & LG_ENTETE_COL) = TEXT_DAT_ECHE_INIT _
                      Then Range(COL_DATE_ECHEANCE & LG_ENTETE_COL) = TEXT_DAT_ECHE
                    'Changement de la colonne EURO
                    Range(DER_COL & LG_ENTETE_COL) = TEXT_MTT_EURO
                    Columns(DER_COL).AutoFit
                    Range(PREM_COL & PREM_LG_BLOC_CLIENT).Select
                                        
                    'Pour les groupementS uniquement
                    '----------------------------------
                    If Type_Groupement(sel) = True Then
                        'Copie de la feuille de données avec nouveau nom
                        Creation_Feuille_Donnees_Groupement _
                          ActiveWorkbook.Name, ActiveSheet.Name
                        
                        'Mise en forme des colonnes dans la feuille
                        Mise_Forme_Feuille_Groupement ActiveWorkbook.Name
                        
                        'Identification de la derniere ligne des données
                        iDerLigne = Determination_Derniere_Ligne(ActiveWorkbook.Name)
                        
                        'Duplication de la détermination de typologie sur tout le tableau
                        'If iDerLigne > LG_PREM_DETAIL
                          'Then Range(COL_TYPE_PROD_GRPMT & LG_PREM_DETAIL).AutoFill _
                         ' Destination:=Range(COL_TYPE_PROD_GRPMT & LG_PREM_DETAIL & ":" _
                          '& COL_TYPE_PROD_GRPMT & iDerLigne)
                         
                        'Range(COL_TYPE_PROD_GRPMT & LG_PREM_DETAIL & ":" _
                         ' & COL_TYPE_PROD_GRPMT & iDerLigne).Copy
                         
                        'Range(COL_TYPE_PROD_GRPMT & LG_PREM_DETAIL & ":" _
                         ' & COL_TYPE_PROD_GRPMT & iDerLigne).PasteSpecial _
                          'Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, _
                          'Transpose:=False
                          
                        'Lissage du format sur toute la colonne
                        'With Range(PREM_COL & LG_ENTETE_COL & ":" _
                        ' & COL_SOLDE_DEV_GRPMT & LG_ENTETE_COL).Borders(xlEdgeBottom)
                         '   .LineStyle = xlContinuous
                          '  .Weight = xlThin
                          '  .ColorIndex = xlAutomatic
                       ' End With
                        
                        Range(PREM_COL & PREM_LG_BLOC_CLIENT).Select
                        
                        'Creation d'une synthèse du compte en tableau croise
                        Creation_Tableau_synthese sFichierTravail, ActiveWorkbook.Name, _
                          iDerLigne
        
                    End If
                        
                    'Recherche du fichier XLS
                    Fic_Existe = Dir(sLeChemin & "\Releves" & sNumClient & ".xls")
                    'Si il existe, on le détruit
                    If Fic_Existe <> "" Then _
                      Kill sLeChemin & "\Releves" & sNumClient & ".xls"
                        
                    'Sauvegarde au format Excel pour assurer une compatibilité avec les clients
                    ActiveWorkbook.SaveAs _
                      Filename:=sLeChemin & "\Releves" & sNumClient & ".xls", _
                      FileFormat:=xlNormal
                    Fichier_Fil = ActiveWorkbook.Name
                End If
                    
                ActiveWorkbook.Close
                ThisWorkbook.Sheets("Releves").Activate
                    
                'Recherche du client dans la feuille releves
                Set motcherch = Columns(COL_NUM_MVT).Find(sNumClient, LookAt:=xlWhole)
                'Si il existe, on le supprime
                If Not motcherch Is Nothing Then Cells(motcherch.Row, 1).EntireRow.Delete
                    
                If Cells(4, 2) <> "" Then ' Si la première ligne est déjà remplie
                    I = Cells(3, 2).End(xlDown).Row + 1
                Else
                    I = 4 ' première ligne
                End If
                    
                'MAJ de la feuille Releves
                Cells(I, 2) = sNumClient
                'Si le relevé n'est pas vide, on indique le nom du client
                If vide False Then Cells(I, 3) Nom_Client
                    
                'Recherche du client dans la feuille infos
                Set motcherch = Sheets("infos").Columns(PREM_COL) _
                 .Find(sNumClient, LookAt:=xlWhole)
                    
                'Si le client existe, on met à jour la feuille releves
                If Not motcherch Is Nothing Then
                    ligner = motcherch.Row
                    Cells(I, 1) = Sheets("infos").Cells(ligner, 3)
                    Cells(I, 4) = Sheets("infos").Cells(ligner, 4)
                    Cells(I, 7) = Sheets("infos").Cells(ligner, 5)
                    
                    'Si le relevé n'est pas vide, on met à jour le nom du client
                    If vide = False Then
                        Sheets("infos").Cells(ligner, 2) = Nom_Client
                        
                    Else
                        'On met le nom de infos dans la feuille releves
                        Cells(I, 3) = Sheets("infos").Cells(ligner, 2)
                    End If
                'Si le client n'existe pas dans la feuille infos
                Else
                    ' On créé le client
                    
                    ' Si la première ligne est déjà remplie
                    If Sheets("infos").Cells(2, 1) <> "" Then
                        Ligne_info = Sheets("infos").Cells(1, 1).End(xlDown).Row + 1
                    Else
                        Ligne_info = 2 ' première ligne
                    End If
                    Sheets("infos").Cells(Ligne_info, 1) = sNumClient
                    
                    ' si le relevé n'est pas vide, on indique le nom du client
                    If vide = False Then
                        Sheets("infos").Cells(Ligne_info, 2) = Nom_Client
                    Else
                        Sheets("infos").Cells(Ligne_info, 2) = "Inconnu !"
                    End If
                    
                    'Pas d'envoi d'Email auto en standard
                    Cells(I, 1) = "Non"
                End If
                
                'Si le relevé n'est pas vide on créé le lien hypertexte avec le relevé XLS
                If vide = False Then
                    ActiveSheet.Hyperlinks.Add Anchor:=Cells(I, 2), _
                      Address:=sLeChemin & "\Releves" & Fichier_Fil
                    Cells(I, 6) = Format(Date, "dd/mm/yy") ' Date de MAJ
                Else
                    Cells(I, 5) = "Vide" ' Le relevé est vide, on le précise
                    Cells(I, 6) = Format(Date, "dd/mm/yy") ' Date de MAJ
                End If
                
            Else ' Il y a eu une erreur à l'ouverture du relevé sur le serveur
                ThisWorkbook.Sheets("Releves").Activate
                
                ' Recherche du client dans la feuille releves
                Set motcherch = Columns(COL_NUM_MVT).Find(sNumClient, LookAt:=xlWhole)
                
                'Si il existe, on le supprime
                If Not motcherch Is Nothing Then Cells(motcherch.Row, 1).EntireRow.Delete
                If Cells(4, 2) <> "" Then ' Si la première ligne est déjà remplie
                    I = Cells(3, 2).End(xlDown).Row + 1
                Else
                    I = 4 ' première ligne
                End If
                Cells(I, 2) = sNumClient
                ' Recherche du client dans la feuille infos
                Set motcherch = Sheets("infos").Columns(PREM_COL) _
                  .Find(sNumClient, LookAt:=xlWhole)
                  
                ' Si le client existe, on met à jour la feuille releves
                If Not motcherch Is Nothing Then
                    ligner = motcherch.Row
                    Cells(I, 3) = Sheets("infos").Cells(ligner, 2)
                End If
                Cells(I, 1) = "Non"
                Cells(I, 5) = "Erreur "
                Cells(I, 6) = Format(Date, "dd/mm/yy") ' Date de MAJ
            End If
            ligne = ligne + 1 ' Ligne suivante
        Loop
    End If
  '  Workbooks(NomCla(sel)).Close
Next

'Fin d'utilisation de progressbar
Application.Run "WKSPRGRS.XLA!ProgressClear"
Columns(COL_NUM_MVT & ":" & COL_DEVISE).EntireColumn.AutoFit
Range(PREM_COL & LG_FINALE_NOM_CLIENT).Sort Key1:=Range(COL_NUM_MVT & LG_FINALE_TRIE), _
    Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
    Orientation:=xlTopToBottom
Workbooks("WKSPRGRS.XLA").Close ' fermeture de la macro progress bar
    
'Fic_Existe = Dir("Z:\DEL.BAT") ' Recherche du fichier
Fic_Existe = Dir("D:\Documents and Settings" & Le_User & "\My Documents\DEL.BAT")
'If Fic_Existe <> "" Then Kill "Z:\DEL.BAT" ' Supression si il existe
If Fic_Existe <> "" Then Kill "D:\Documents and Settings" & Le_User & "\My Documents\DEL.BAT"
Stat ' procédure d'alimentation des statistiques
Application.StatusBar = False
Exit Sub
    
err_ouverture_client: ' Erreur d'ouverture d'un fichier client
    Erreur_Cli = True
    Resume Next
    
erreur_ouverture: ' Problème de connexion ou pas de traitement disponible
    MsgBox Prompt:="connexion impossible ou pas de traitement disponible pour " & Le_User, _
        Buttons:=vbCritical, Title:="Erreur d'ouverture"
    Application.StatusBar = False
    Exit Sub
    
erreur_Classeur:
    erreur = True
    Resume Next
    
End Sub

' ----------------------------------------------------------------------------------------
' Procédure     : Stat
' Evénement     : Appelée par la procédure index
' Rôle          : Mise à jour du tableau des statistiques
' MAJ           : 30/09/1999
' ----------------------------------------------------------------------------------------

Sub Stat()
    On Error GoTo annule ' Ce traitement facultatif est annulé en cas d'erreur
    Open Chemin_Stat & "\STAT" For Append As #1
    Write #1, Le_User; Total_Cli; Date; Time
    Close #1
    Exit Sub
annule:
    Close #1
    Exit Sub
End Sub

' ----------------------------------------------------------------------------------------
' Procédure     : SendMail
' Evénement     : Appelée par le bouton 'Envoyer tous les relevés / mail' de la feuille
'                 Releves de ce classeur
' Rôle          : Envoi automatique des mails
' MAJ           : 30/09/1999
' ----------------------------------------------------------------------------------------

Sub SendMail()
    ' Déclarations
    Dim reponse_mail As Double ' Variable du statut de la boite de dialogue
    Dim ereur As Double ' Compteur des erreurs d'envoi
    Dim nbr As Double ' Nombre de clients à traiter
    Dim dest As String ' Destinataire du relevé
    Dim sujet As String ' Objet du message envoyé
    '
    reponse_mail = MsgBox(Prompt:="Veuillez confirmer l'envoi des mails aux clients", _
        Buttons:=vbQuestion + vbYesNo, Title:="Envoi des relevés par mail")
    If reponse_mail = vbNo Then Exit Sub ' Demande de confirmation avant envoi
    I = 4 ' premier client
    ereur = 0
    nbr = Cells(4, 2).CurrentRegion.Rows.Count - 1
    
    'On boucle sur l'ensemble des clients présents dans la feuille releves
    Do While Cells(I, 2) <> ""
        'On envoi un mail en cas de statut à OUI pour un relevé
        'qui n'est pas vide et comportant un Email
        If UCase(Cells(I, 1)) = "OUI" And Trim(Cells(I, 4)) <> "" _
          And Cells(I, 5) <> "Vide" Then
            dest = Cells(I, 4)
            sujet = Cells(I, 7)
            Application.StatusBar = "Traitement en cours : " & Format((I - 3) / nbr, "0%") & " erreurs " _
                & ereur & " sur " & I - 3 & " " & Cells(I, 3)
                
            'On affiche le relevé
            Cells(I, 2).Hyperlinks.Item(1).Follow
            On Error GoTo Traiterr ' En cas d'erreur on le signale
            ThisWorkbook.Sheets("Releves").Cells(I, 5) = "" ' On met à vide le statut
            If sujet <> "" Then ' Envoi avec ou sans objet
                ActiveWorkbook.SendMail Recipients:=dest, Subject:=sujet
            Else
                ActiveWorkbook.SendMail Recipients:=dest
            End If
            ActiveWorkbook.Close SaveChanges:=False ' On ferme le relevé
            On Error GoTo 0
        End If
        I = I + 1 ' client suivant
    Loop
    Application.StatusBar = False
    Exit Sub
Traiterr:
ThisWorkbook.Sheets("Releves").Cells(I, 5) = "ERREUR"
ereur = ereur + 1
Resume Next
End Sub

' ----------------------------------------------------------------------------------------
' Procedure     : Send_Ce_Mail
' Evénement     : Appelée par le bouton 'Envoyer ce relevé / mail' de la feuille
'                 Releves de ce classeur
' Rôle          : Envoi d'un mail particulier - Celui présent dans la ligne de la cellule
'                 active
' MAJ           : 30/09/1999
' ----------------------------------------------------------------------------------------

Sub Send_Ce_Mail()
    ' Déclarations
    Dim dest As String ' Destinataire du relevé
    Dim sujet As String ' Objet du message envoyé
    '
    I = ActiveCell.Row ' Ligne active
    ' On envoi un mail pour un relevé qui n'est pas vide et comportant un Email
    If Trim(Cells(I, 4)) <> "" And Cells(I, 5) <> "Vide" Then
        dest = Cells(I, 4)
        sujet = Cells(I, 7)
        Cells(I, 2).Hyperlinks.Item(1).Follow ' On affiche le relevé
        On Error GoTo Traiterr ' En cas d'erreur on le signale
        ThisWorkbook.Sheets("Releves").Cells(I, 5) = "" ' On met à vide le statut
        If sujet <> "" Then ' Envoi avec ou sans objet
            ActiveWorkbook.SendMail Recipients:=dest, Subject:=sujet
        Else
            ActiveWorkbook.SendMail Recipients:=dest
        End If
        ActiveWorkbook.Close SaveChanges:=False ' On ferme le relevé
        On Error GoTo 0
    End If
    Exit Sub
Traiterr:
ThisWorkbook.Sheets("Releves").Cells(I, 5) = "ERREUR"
Resume Next
End Sub

'----------------------------------------------------------------------------
Sub Test()
Range("C9").FormulaR1C1 = _
    "=IF(LEN(RC[-1])=9,""Verres"",IF(RIGHT(LEFT(RC[-1],2),1)=""6"",""Instruments"",""""))"
    '"=IF(LEN(RC[-1])=9,""Verres"",IF(OR(LEFT(RC[-1],2)=""86"",LEFT(RC[-1],2)=""96"",LEFT(RC[-1],2)=""06"",LEFT(RC[-1],2)=""16"",LEFT(RC[-1],2)=""26""),""Instruments"",IF(OR(LEFT(RC[-1],2)=""80"",LEFT(RC[-1],2)=""90"",LEFT(RC[-1],2)=""91"",LEFT(RC[-1],2)=""00"",LEFT(RC[-1],2)=""01"",LEFT(RC[-1],2)=""10"",LEFT(RC[-1],2)=""11"",LEFT(RC[-1],2)=""21""),""Contacts"","""")))"
                                
End Sub
'----------------------------------------------------------------------------
'Creation_Feuille_Donnees_Groupement
'Role : Creation d'une feuille de travail pour les groupements
'Entree :       sNomFichierEnCours -> nom du fichier du groupement en cours
'               sFeuilleSource -> feuille source de la copie
'Constante :    FEUIL_DONNEES
'----------------------------------------------------------------------------
Sub Creation_Feuille_Donnees_Groupement(sNomFichierEnCours As String, _
  sFeuilleSource As String)
        Sheets(sFeuilleSource).Copy After:=Workbooks(sNomFichierEnCours).Sheets(1)
        
        ' Renomer la feuille
        ActiveSheet.Name = FEUIL_DONNEES
End Sub

'----------------------------------------------------------------------------------
'Mise_Forme_Feuille_Groupement
'Role : Mise en forme de la feuille de travail pour les groupements
'Entree :       sNomFichierGroupement -> nom du fichier du groupement en cours
'Constante :    FEUIL_DONNEES,PREM_COL,LG_ENTETE_COL,COL_DATE_TRANSACT,
'               COL_TYPE_PROD_GRPMT, LG_PREM_DETAIL
'----------------------------------------------------------------------------------
Sub Mise_Forme_Feuille_Groupement(sNomFichierGroupement As String)

    'Activation de la feuille
    Workbooks(sNomFichierGroupement).Sheets(FEUIL_DONNEES).Activate
    
    'On remplace le terme "Compte"
    Range(PREM_COL & LG_ENTETE_COL) = TEXT_ADH
    'Columns(COL_DATE_TRANSACT).Insert Shift:=xlToRight
    'Columns(COL_TYPE_PROD_GRPMT).NumberFormat = "General"
                        
    'On créé une rubrique pour indiquer le type de produits
    'Range(COL_TYPE_PROD_GRPMT & LG_ENTETE_COL) = TEXT_TYP
    'MAJ 31/01/00 et 03/03/00 Ajout des N° factures 2000, 2001
    'Range(COL_TYPE_PROD_GRPMT & LG_PREM_DETAIL).FormulaR1C1 = _
        '"=IF(LEN(RC[-1])=9,""Verres"",IF(RIGHT(LEFT(RC[-1],2),1)=""6"",""Instruments"",IF(LEFT(RC[-1],1)=""G"",""Montage"","""")))"
    
    '"=IF(LEN(RC[-1])=9,""Verres"",IF(OR(LEFT(RC[-1],2)=""86"",LEFT(RC[-1],2)=""96"",LEFT(RC[-1],2)=""06"",LEFT(RC[-1],2)=""16""),""Instruments"",IF(OR(LEFT(RC[-1],2)=""80"",LEFT(RC[-1],2)=""90"",LEFT(RC[-1],2)=""91"",LEFT(RC[-1],2)=""00"",LEFT(RC[-1],2)=""01"",LEFT(RC[-1],2)=""10"",LEFT(RC[-1],2)=""11""),""Contacts"","""")))"

End Sub

'-----------------------------------------------------------------------------------
'Determination_Derniere_Ligne
'Role : Détermination de la derniere ligne du tableau avec suppression des sauts de
'       ligne et de la ligne de sous total avant la ligne blanche
'
'Entree :       sNomFichierGroupement -> nom du fichier du groupement en cours
'Constante :    FEUIL_DONNEES,COL_NUM_MVT,LG_ENTETE_COL,COL_DEVISE,TEXT_SOUSTT
'-----------------------------------------------------------------------------------
Function Determination_Derniere_Ligne(sNomFichier As String) As Double
Dim iLaDerLigne As Double  'Derniere ligne du tableau
Dim rDerCellule As Range    'Derniere cellule en cours
Dim iLaLigneSupp As Double  'Derniere ligne du tableau

    'Activation de la feuille
    Workbooks(sNomFichier).Sheets(FEUIL_DONNEES).Activate
    
    'Determination du 1er bloc
    Let iLaDerLigne = Range(COL_NUM_MVT & LG_ENTETE_COL).End(xlDown).Row
    Set rDerCellule = Range(COL_DEVISE & iLaDerLigne)
    
    'Tant que 2 lignes au dessous non vide
    While rDerCellule.Offset(5, 0) <> ""
        'Supprimer les lignes suivantes 2 vides + 2 sous totaux
        Let iLaLigneSupp = iLaDerLigne + 1
        Rows(iLaLigneSupp & ":" & iLaLigneSupp).Delete Shift:=xlUp
        Rows(iLaLigneSupp & ":" & iLaLigneSupp).Delete Shift:=xlUp
        Rows(iLaLigneSupp & ":" & iLaLigneSupp).Delete Shift:=xlUp
        Rows(iLaLigneSupp & ":" & iLaLigneSupp).Delete Shift:=xlUp
        
        'Réinitialiser la derniere ligne
        Let iLaDerLigne = Range(COL_NUM_MVT & LG_ENTETE_COL).End(xlDown).Row
        Set rDerCellule = Range(COL_DEVISE & iLaDerLigne)
    Wend
    
    'Suppression des derniere ligne de totalisation non significatif
    Let iLaLigneSupp = iLaDerLigne + 1
    Rows(iLaLigneSupp & ":" & iLaLigneSupp).Delete Shift:=xlUp
    Rows(iLaLigneSupp & ":" & iLaLigneSupp).Delete Shift:=xlUp
    Rows(iLaLigneSupp & ":" & iLaLigneSupp).Delete Shift:=xlUp
    
    Let Determination_Derniere_Ligne = iLaDerLigne
    
End Function

'-----------------------------------------------------------------------------------
'Creation_Tableau_synthese
'Role : Creation du tableau dymanique croise sur les groupements
'
'Entree :       sNomFichierGroupement -> nom du fichier du groupement en cours
'               sNomFichierT -> nom du fichier de la macro en cours
'
'Constante :    FEUIL_DONNEES,COL_SOLDE_DEV_GRPMT,LG_ENTETE_COL,PREM_COL,
'               COL_SOLDE_DEV_GRPMT,TAB_NAME,PREM_LG_BLOC_CLIENT
'-----------------------------------------------------------------------------------
Sub Creation_Tableau_synthese(sNomFichierT As String, sNomFichierGrpt As String, _
  iDerniereLgn As Double)
Dim iLongText As Double    'Longueur du texte des donnees
Dim iLongSomme As Double   'Longueur du texte somme
Dim rCelluleReste As Range  'Cellule de reste du
Dim rCelluleEuro As Range   'Cellule de l'Euro
Dim rCellDefTab As Range    'Tableau dyn
Dim iDerLigneTab As Double 'Dernière ligne du tableau dynamique
Dim iDerColTab As Double   'Dernière colonne du tableau dynamique

    'Activation de la feuille
    Workbooks(sNomFichierGrpt).Sheets(FEUIL_DONNEES).Activate

    ' Determination de la valeur pivot en fonction Anglais/Français
    If Range(COL_SOLDE_DEVISE & LG_ENTETE_COL) = "Amount due remaining" Then
        ' Valeur pivot en Anglais
        ValeurPivot = TEXT_RESTE_ANG
    Else
        ValeurPivot = TEXT_RESTE_FRF
    End If
                        
    'Debute l'activation de la construction du tableau : definie la source
    ActiveSheet.PivotTableWizard SourceType:=xlDatabase, SourceData:= _
        Range(PREM_COL & LG_ENTETE_COL & ":" & COL_SOLDE_DEVISE & iDerniereLgn), _
        TableDestination:="", TableName:=TAB_NAME
                            
    'Definie les lignes et colonnes
    ActiveSheet.PivotTables(TAB_NAME).AddFields RowFields:= _
         Array("Date", "Devise"), ColumnFields:="Type"
                           
    '... avec la valeur de pivot
    With ActiveSheet.PivotTables(TAB_NAME).PivotFields(ValeurPivot)
      .Orientation = xlDataField
      .Position = 1
      .NumberFormat = "#,##0.00;[Red]-#,##0.00"
    End With
                        
    ' ... et le format des montants
    'With ActiveSheet.PivotTables(TAB_NAME).PivotFields(TEXT_MTT_EURO)
    '  .Orientation = xlDataField
    '  .Position = 2
    '  .NumberFormat = "#,##0.00;[Red]-#,##0.00"
    'End With
    
    '
    ActiveSheet.PivotTables(TAB_NAME).PivotSelect "Date[Tous]", xlLabelOnly
                                                
    Selection.Group Start:=True, End:=True, _
       Periods:=Array(False, False, False, False, True, False, True)
       ActiveSheet.PivotTables(TAB_NAME).PivotSelect "Date[Tous]", xlLabelOnly
       
    ' Renomer la feuille
    ActiveSheet.Name = TAB_NAME
       
    ' Definie la dimension du tableau en EURO
    Set rCellDefTab = Sheets(TAB_NAME).Range("D3").CurrentRegion
    Let iDerLigneTab = rCellDefTab.Rows.Count
    Let iDerColTab = rCellDefTab.Columns.Count
    'Coloriage Cells(iDerLigneTab, iDerColTab), 19
     
    CreerColEURO sNomFichierT, sNomFichierGrpt, iDerLigneTab, iDerColTab
    
    ' Renomme la partie "Somme"
'    Let iLongSomme = Len(TEXT_SOMME)
'    Set rCelluleReste = Sheets(TAB_NAME).Range(CELL_RESTE_DU)
'    Let iLongText = Len(rCelluleReste.Value)
'    Let rCelluleReste.Value = Right(rCelluleReste.Value, iLongText - iLongSomme)
     
'    Set rCelluleEuro = Sheets(TAB_NAME).Range(CELL_EURO)
'    Let iLongText = Len(rCelluleEuro.Value)
'    Let rCelluleEuro.Value = Right(rCelluleEuro.Value, iLongText - iLongSomme)
     
    Range(PREM_COL & PREM_LG_BLOC_CLIENT).Select
    

End Sub

'-----------------------------------------------------------------------------------
'CreerColEURO
'Role : Creer la colonne en EURO
'
'Entree :       sNomFichierTrav -> nom du fichier de la macro
'               sNomFichierGroupement -> nom du fichier du groupement en cours
'               iDerLgnTab -> dernière ligne du tableau dynamique
'               iDerColTab -> dernière colonne du tableau dynamique
'
'Constante :    FEUIL_DONNEES,COL_SOLDE_DEV_GRPMT,LG_ENTETE_COL,PREM_COL,
'               COL_SOLDE_DEV_GRPMT,TAB_NAME,PREM_LG_BLOC_CLIENT, TEXT_SOMME
'-----------------------------------------------------------------------------------
Sub CreerColEURO(sFichierTrav As String, sNomFichGrpt As String, _
  iDerLgnTab As Double, iDerColTab As Double)

Dim sgTauxConver As Single  'Taux de conversion recupere
Dim rCellDevise As Range    'Libelles de devise
Dim rCellEuro As Range      'Total Euro
Dim rCellTest As Range      'Zone d'identification de la ligne
Dim iColEuro As Double      'Colonne EURO

'Compteur pour determination des zone de sous.total
Dim iCptLigneInit As Double    'Position de la 1er ligne de bloc
Dim iLgnEncours As Double      'Position de la ligne en cours
Dim iCptLignMois As Double     'Cpt des mois traite
    
    'Positionnement de la 1er cellule EURO
    Set rCellEuro = Workbooks(sNomFichGrpt).Sheets(TAB_NAME). _
      Cells(LG_1ER_DYN - 1, iDerColTab + 1)
      
    Let iColEuro = rCellEuro.Column
     
    Let rCellEuro.Value = TEXT_MTT_EURO
    rCellEuro.HorizontalAlignment = xlCenter
    rCellEuro.Offset(0, -1).HorizontalAlignment = xlCenter
     
    'Initialisation des compteurs de ligne pour les sous totaux
    Let iCptLigneInit = LG_1ER_DYN
    Let iCptLignMois = 0
    
    'Pour toute la hauteur du tableau
    For iLgnEncours = LG_1ER_DYN To iDerLgnTab '+ 1
      Set rCellTest = Workbooks(sNomFichGrpt).Sheets(TAB_NAME). _
        Range(COL_TEST_DYN & iLgnEncours)
      Set rCellEuro = Workbooks(sNomFichGrpt).Sheets(TAB_NAME). _
        Cells(iLgnEncours, iColEuro)
      
      'Si ce n'est pas une ligne de somme
      Select Case Left(rCellTest.Text, 5)
        'test si total mois
        Case TEXT_SOMME
            'faire un sous total avec libelle de sous.total(iCptLignMoisInit, iCptLignMois)
            'Coloriage rCellEuro, 8
            Let iCptLignMois = iCptLigneInit - iLgnEncours
            Let rCellEuro.FormulaR1C1 = _
              "=SUBTOTAL(9,R[" & iCptLignMois & "]C:R[-1]C)"
            'Reinitialiser la 1er valeur du sous.total
            Let iCptLigneInit = iLgnEncours + 1
            
        'Si la cellule testee semble vide
        Case ""
            'Cas du total final
            If Left(rCellTest.Offset(0, -1).Text, 5) = TEXT_SOUSTT Then
                'faire le total général de LG_1ER_DYN a iCptLigne
                'Coloriage rCellEuro, 16
                Let iCptLignMois = LG_1ER_DYN - iLgnEncours
                Let rCellEuro.FormulaR1C1 = _
                  "=SUBTOTAL(9,R[" & iCptLignMois & "]C:R[-2]C)"
                  
             'cas des 2nd et autres lignes mensuelles
             Else
                'Initialise la valeur de devise
                Set rCellDevise = Workbooks(sNomFichGrpt).Sheets(TAB_NAME).Range(COL_DEVISE_DYN & iLgnEncours)
                'Coloriage rCellDevise, 8
        
                'Recherche la valeur du taux
                Let sgTauxConver = RechercheTauxConversion(sFichierTrav, rCellDevise.Value)
        
                'Converti le montant total
                Let rCellEuro.Value = rCellEuro.Offset(0, -1) / sgTauxConver
                'Coloriage rCellEuro, 8
            End If
        Case Else
            'Initialise la valeur de devise
            Set rCellDevise = Workbooks(sNomFichGrpt).Sheets(TAB_NAME).Range(COL_DEVISE_DYN & iLgnEncours)
            'Coloriage rCellDevise, 8
        
            'Recherche la valeur du taux
            Let sgTauxConver = RechercheTauxConversion(sFichierTrav, rCellDevise.Value)
        
            'Converti le montant total
            Let rCellEuro.Value = rCellEuro.Offset(0, -1) / sgTauxConver
            'Coloriage rCellEuro, 8
               
        End Select
        rCellEuro.NumberFormat = "#,##0.00;[Red]-#,##0.00"
    Next
    rCellEuro.Select
    
End Sub

'-----------------------------------------------------------------------------------
'RechercheTauxConversion
'Role : Recherche le taux de conversion
'
'Entree :       sFicherW As String -> Nom du fichier de la macro
'               sDevise -> Nom de la devise a rechercher
'
'Constante :    FEUIL_TAUX,TAB_TAUX,COL_DEV_TAUX,COL_VAL_TAUX
'-----------------------------------------------------------------------------------
Function RechercheTauxConversion(sFicherW As String, sDevise As String) As Single

Dim rCellDevTrouvee As Range
Dim rCellValTaux As Range
    
    'Trouver la ligne de la devise
    Set rCellDevTrouvee = Workbooks(sFicherW).Sheets(FEUIL_TAUX).Range(TAB_TAUX).Columns(COL_DEV_TAUX) _
     .Find(sDevise)
    
    'Recuperer la valeur du taux
    Set rCellValTaux = rCellDevTrouvee.Offset(0, COL_VAL_TAUX)
    
    'Transmettre cette valeur de taux
   Let RechercheTauxConversion = rCellValTaux.Value
    
End Function

'=======================================================================
' Coloriage
' Role : Procedure qui colorie la zone fournie en parametre
'
' En entree :   rCellColor As Range 'zone a colorier
'               iCouleur As Double 'index de la couleur
'
' En sortie : rien
'=======================================================================
Sub Coloriage(rCellColor As Range, iCouleur As Double)
    With rCellColor.Interior
        .ColorIndex = iCouleur              'Choix de la couleur
        .Pattern = xlSolid                  'Motif plein
        .PatternColorIndex = xlAutomatic    'Couleur de motif
    End With
End Sub


La seule chose dont j'ai besoin, c'est modifier cette ligne :
 Workbooks.OpenText Filename:=Chemin_Reseau & "LGEMIREPEX.form.*" & "." & Le_ID


Le caractère * n'est pas reconnu. J'ai fais un test : la macro fonctionne si je mets les 12 caractères en dur. Il faut absolument que je puisse "sauter" ces 12 caractères pour prendre en compte tous les fichiers du répertoire.
0