Mise à jour de plusieur fichiers dans des dossiers et sous dossiers

Morgane

XLDnaute Nouveau
Bonjour à tous,

J'ai un soucis sur la macro que je viens d'adapter pour mes besoins. Etant un néophyte en macro excel, je fait appel à votre expérience et votre sympathie pour voir si vous pouvez faire quelque chose pour moi :confused:

La code qui suit est censé ouvrir chaque dossiers et sous dossiers pour ensuite ouvrir les fichiers qui y sont contenus afin de les mettre à jour via un procédure contenu dans le code (MAJ_fichier).

Cependant, je n'ai pas l'impression que cela fonctionne correctement, en effet, lorsque je lance la procédure, la première parti fonctionne bien (séléction du dossier à traiter) mais c'est ensuite que ça se gate. Le traitement ne fait pas ce que je veux. Je vois bien que mon PC travail, mais je ne sais pas ce qu'il fait car la mise à jour ne se fait pas.

Je sais que les routines suivantes fonctionnent car déjà utilisées (mais pas dans une macro) :

- Sub prepa_factu_presta()
- Sub prepa_factu_transp()
- Sub prepa_factu_CDC()

Je pense que la procédure Sub Choisir_Fichier() fonctionne car le navigateur m'ouvre bien une boite de dialogue pour séléctionner un dossier à traiter.

Le problème est surement sur la procédure Sub Ouvrir_Fichier (enfin je crois ?)

Cette macro est dans un module sur un classeur "de pilotage" qui possède uniquement cette macro.

Voici le code :

PHP:
Option Explicit

Dim Fso As Scripting.FileSystemObject
Dim Nomdossiers As Scripting.Folders
Dim Nomfichiers As Scripting.Files
Dim ApplSelectionDossier As FileDialog

Sub Choisir_Fichier()

'Création de la boite de dialogue
Set ApplSelectionDossier = Application.FileDialog(msoFileDialogFolderPicker)

'Choix du dossier
With ApplSelectionDossier

    'Titre de la boite de dialogue
    .Title = "Selectionnez un dossier"

    'L'utilisateur à cliqué sur le bouton OK de la boite de dialogue
    If .Show = -1 Then

        'Créer un objet de gestion des fichiers
        Set Fso = CreateObject("Scripting.FileSystemObject")
        
        'Affecte la liste des sous dossiers du dossier sélectionné
        Set Nomdossiers = Fso.GetFolder(.SelectedItems(1)).SubFolders
        
        'Affecte la liste des fichiers du dossier en-cours
        Set Nomfichiers = Fso.GetFolder(.SelectedItems(1)).Files
        
        'Appel de la procédure d'ouverture des fichiers
        Call Ouvrir_Fichier(Nomdossiers, Nomfichiers)
        
    'L'utilisateur à cliqué sur le bouton annuler
    Else
    
    End If
    
End With

End Sub

PHP:
Sub Ouvrir_Fichier(Nomdossiers As Scripting.Folders, Nomfichiers As Scripting.Files)

Dim Nomdossier As Scripting.Folder
Dim Nomfichier As Scripting.File


If Nomfichiers Is Nothing Then

Else

    'Pour chaque fichier de la liste de fichiers
    For Each Nomfichier In Nomfichiers
    
        'Si L'extension du fichier est .xslx ou .xslm
        If Right(Nomfichier, 5) = "xslx" Or Right(Nomfichier, 5) = "xslm" Then
        
            'Ouvrir le fichier
            Workbooks.Open Filename:=Nomfichier
        
Call MAJ_fichiers

            'Enregistrer avant de fermer
            ActiveWorkbook.Save
        
            'Ferme le fichier
            ActiveWorkbook.Close
        
        End If
        
    Next
    
End If

If Nomdossiers Is Nothing Then

Else

        'Pour chaque dossier de la liste de dossiers
        For Each Nomdossier In Nomdossiers
        
        'Créer un objet de gestion des fichiers
        Set Fso = CreateObject("Scripting.FileSystemObject")
        
        'Affecte la liste des fichiers du dossiers en cours
        Set Nomfichiers = Fso.GetFolder(Nomdossier.Path).Files
        
        'Appel la procédure d'ouverture des fichiers (récursif)
        Call Ouvrir_Fichier(Nomdossier.SubFolders, Nomfichiers)
        
    'Dossier suivant
    Next Nomdossier
    
End If

End Sub

PHP:
Sub MAJ_fichiers()

Worksheets(1).Unprotect Password:="admin"

    Select Case ("Sujet")
        Case Left("Sujet", 3) = "PRE"
            Call prepa_factu_presta
        Case Left("Sujet", 3) = "TRA"
            Call prepa_factu_transp
        Case Left("Sujet", 3) = "CDC"
            Call prepa_factu_CDC
        Case Else
            MsgBox "Pas de traitement"
    End Select
    
Worksheets(1).Protect Password:="admin"

End Sub

PHP:
Sub prepa_factu_presta()
    
' prepa_factu Macro

    Worksheets(1).Unprotect Password:="admin"
    Range("A2").Select
    Selection.ClearContents
    Range("F4").Select
    ActiveCell.Value = "7/31/2012"
    Range("H5").Select
    ActiveCell.Value = "PRESTATION JUILLET 2012"
 
    Range("M").Select
    Selection.Copy
    Range("M_1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("Del").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    
    Worksheets(1).Protect Password:="admin"
    
    MsgBox ("Yeaah all wright !")
    
End Sub

PHP:
Sub prepa_factu_transp()
    
' prepa_factu Macro

    Worksheets(1).Unprotect Password:="admin"
    Range("A2").Select
    Selection.ClearContents
    Range("F4").Select
    ActiveCell.Value = "7/31/2012"
    Range("H5").Select
    ActiveCell.Value = "TRANSPORT JUILLET 2012"
 
    Range("M").Select
    Selection.Copy
    Range("M_1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("Quantite").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    
    Worksheets(1).Protect Password:="admin"
    
    MsgBox ("Yeaah all wright !")
    
End Sub

PHP:
Sub prepa_factu_CDC()
    
' prepa_factu Macro

    Worksheets(1).Unprotect Password:="admin"
    Range("A2").Select
    Selection.ClearContents
    Range("F4").Select
    ActiveCell.Value = "7/31/2012"
    Range("H5").Select
    ActiveCell.Value = "CDC JUILLET 2012"
 
    Range("M").Select
    Selection.Copy
    Range("M_1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("Quantite").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    
    Worksheets(1).Protect Password:="admin"
    
    MsgBox ("Yeaah all wright !")
    
End Sub

Si vous avez des remarques ou quoi que ce soit, je suis preneur et surtout si vous avez des solutions à m'apporter, je vous en serait très reconnaissant.

Merci à tous.
 

Pièces jointes

  • Pilotage MAJ.xlsm
    21.3 KB · Affichages: 54
  • FAC Trsp code cli 2012-07.xlsm
    29 KB · Affichages: 50
  • FAC Presta code cli 2012-07.xlsm
    33.1 KB · Affichages: 64
Dernière édition:

Staple1600

XLDnaute Barbatruc
Re : Mise à jour de plusieur fichiers dans des dossiers et sous dossiers

Re,


Merci pour le feedback

Une dernier petit conseil:
Si j'étais toi, j'utiliserai un mot de passe un peu moins commun et je protégerai le ProjetVBA avec un mot de passe (différent évidemment)
 
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
312 083
Messages
2 085 182
Membres
102 808
dernier inscrit
guo