Macro modification fichiers en Masse : erreur Type 13

[xadout]

Bonjour,

Je suis novis dans la macro excel. On m'a demandé de faire une modification d'une grosse centaine de fichiers excel.
J'esssai d'y passer par macro :
Voici mon code :

Sub Protection()
MotPasse = "AAAA"
For Each Feuil In Worksheets  ' https://msdn.microsoft.com/fr-fr/library/office/ff840611.aspx
Feuil.Protect Password:=MotPasse, DrawingObjects:=False, Contents:=True, Scenarios:= _
        False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
        AllowFormattingRows:=True
Next
End Sub


Sub Déprotection()
MotPasse = "AAAA"
For Each Feuil In Worksheets
Feuil.Unprotect MotPasse
Next
End Sub


Sub MRaccourci()
Set scrHst = CreateObject("WScript.Shell")
emplacement = "x:\Raccourcis FP & FD"
Set Raccourci = scrHst.CreateShortcut(emplacement & "\" & ThisWorkbook.Name & ".lnk")
Raccourci.WorkingDirectory = emplacement
Raccourci.TargetPath = ActiveWorkbook.FullName
Raccourci.Save
Set Raccourci = Nothing
Set scrHst = Nothing
  Range("C3").Select
End Sub

' Appel de la fonction
Option Explicit
Public nb As Integer
Sub Appel()
Dim chemin As String
    nb = 0
    chemin = "x:\Informatique"
    Modifier chemin
End Sub


Public Function Modifier(chemin As String)
Dim fs, Rep As Variant, NewRep As String, Nomfich As String
    Set fs = CreateObject("Scripting.FileSystemObject")
    Lister = fs.GetFolder(chemin).Files.Count
    Nomfich = Dir(chemin & "\*.xls")
    Do While Nomfich <> ""
        nb = nb + 1
        Workbooks.Open chemin & "\" & Nomfich 'Ouvre fichier'
        Déprotection 'déprotège
        MRaccourci 'crée le raccourcis
        Worksheets("FP JUIN").Range("T49").Value = "" 'Supprime contenu cellule
        Worksheets("MARS").Rows("16").EntireRow.Hidden = False 'Affiche ligne 16 mars
        Worksheets("MARS").Range("C16:AY16").Locked = True 'Verouille ligne 16 mars de C à AY
        Protection
        Nomfich = Dir()
    Loop
    'Pour chaque sous-répertoire, appel récursif de Lister
    For Each Rep In fs.GetFolder(chemin).SubFolders
        NewRep = Lister(Rep.Path)
    Next Rep
End Function

J'ai une erreur d'éxécution de Type 13, incompatilité de type à la ligne
NewRep = Lister(Rep.Path)

NewRep est bien déclaré....
Si quelqu'un à une piste 🙂

 

[Roland_M]

bonsoir,

oui mais Lister() !? n'est pas déclaré !? c'est quoi ? un appel fonction, un tableau !?

 

[xadout]

Lister représente celà (3 lignes après Public Function Modifier(chemin As String))
Lister = fs.GetFolder(chemin).Files.Count

 

[Roland_M]

Bonjour,

effectivement j'étais pas réveillé !

mais l'erreur vient du fait que tu utilises Lister comme un tableau et en plus en alphanumérique
alors que c'est du numérique et ce n'est pas un tableau !
c'est une variable numérique qui représente le nombre de fichiers
Lister = fs.GetFolder(chemin).Files.Count (< = Nbr de Fichiers dans le Rep) exp Lister = 32

ici NewRep = Lister(Rep.Path)
si tu avais réellement une liste des répertoires ce serait
NewRep = Lister(NoIndice)

comme tu pratiques ça ne peut pas fonctionner
si j'ai le temps j'y regarderai

a savoir ici cette remarque 'Pour chaque sous-répertoire, appel récursif de Lister
ce n'est pas du récursif du tout !
récursif(en faisant simple) c'est une macro qui s'appelle elle même !
ici à l'intérieur de cette Sub il y aurait
Public Function Modifier(chemin As String)
. . .
For Each ... sur les sous reps
Modifier Rep
Next
. . .
End Sub

EDIT:
tes fichiers sont dans un seul répertoire ou avec les sous reps ?
car si c'est un seul rep pas besoin de récursif !?

et puis dans ta boucle tu ouvres les fichiers pour modif mais tu ne refermes rien !?

et ceci: Nomfich = Dir(chemin & "\*.xls")
est-ce uniquement xls ?
car ça va boucler sur toutes les extensions xlsm xlsx . . . !
c'est pareil si tu avais mis "*xls*" !
si c'est que les xls il faudra re-tester l'extension !

 

[Roland_M]

re

voir ton code avec les deux routines !
tu vérifies, puis tu fais un essai en créant un RepTemp avec qq fichiers
et tu me dis quoi !?

 

[Roland_M]

Bonjour tout le monde,

qu'en est-il svp ?