1. #1
    Nouveau membre du Club
    Homme Profil pro
    activités diverses et variées
    Inscrit en
    juillet 2013
    Messages
    24
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Belgique

    Informations professionnelles :
    Activité : activités diverses et variées

    Informations forums :
    Inscription : juillet 2013
    Messages : 24
    Points : 26
    Points
    26

    Par défaut Supprimer des centaines, des milliers de macros, modules, formulaires!

    Bonjour,
    Présentation :
    J'ai un énorme répertoire remplis de pleins de trucs dont pleins de fichiers.doc
    Beaucoup de ces fichiers.doc contiennent des formulaires et modules qui ne me sont plus utiles et prennent de la place..

    Ce serait vraiment très audacieux de parvenir à créer un code qui fonctionnerait comme suit :
    Dans un répertoire donné (dossiers, sous-dossiers) :
    - trouver tous les fichiers.doc
    - en ouvrir un (le premier),
    - supprimer les formulaires, modules, ..
    - le sauvegarder,
    - ouvrir le suivant,
    - idem, etc.

    Actuellement je gère ça au coup par coup comme ceci (trouvé d'ailleurs sur ce site) :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    Dim LeDoc As Document, MotdePasse As String
    Set LeDoc = ThisDocument
    MotdePasse = "toto"
    UnprotectVBProject LeDoc, MotdePasse
     
    For Each VbComp In ThisDocument.VBProject.VBComponents
            Select Case VbComp.Type
                Case 1 To 3
                    ThisDocument.VBProject.VBComponents.Remove VbComp
                Case Else
                    With VbComp.CodeModule
                    .DeleteLines 1, .CountOfLines
                    End With
            End Select
        Next VbComp
    J'ignore si c'est réalisable. En tous cas, je l'espère et donc merci d'avance pour votre aide précieuse!

  2. #2
    Membre confirmé Avatar de Souriane
    Femme Profil pro
    Assistant aux utilisateurs
    Inscrit en
    septembre 2009
    Messages
    377
    Détails du profil
    Informations personnelles :
    Sexe : Femme
    Localisation : Canada

    Informations professionnelles :
    Activité : Assistant aux utilisateurs
    Secteur : Service public

    Informations forums :
    Inscription : septembre 2009
    Messages : 377
    Points : 546
    Points
    546

    Par défaut

    Bonjour,

    Voici le code que j'utilise quand je veux effectuer une tâche sur les documents d'un répertoire.

    Tu n'as qu'à l'adapter!

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    Public Sub ActionSurTousLesFichiersRepertoire()
     
    'Changer le répertoire sous "PathToUse
     
    Application.ScreenUpdating = True
     
    Dim myFile As String
    Dim PathToUse As String
    Dim myDoc As Document
    Dim Response As Long
     
    PathToUse = "c:\temp\"    'Changer ici le répertoire
     
    'Error handler to handle error generated whenever
    'the FindReplace dialog is closed
     
    On Error Resume Next
     
    'Close all open documents before beginning
     
    Documents.Close SaveChanges:=wdPromptToSaveChanges
     
     
    myFile = Dir$(PathToUse & "*.doc*")     'Ici, indique de traiter tous les document .doc, donc ça inclus les docx, docm, etc.  Modifier au goût.
     
    While myFile <> ""
     
    WordBasic.DisableAutoMacros 1   'Disables auto macros
     
        'Open document
            Set myDoc = Documents.Open(PathToUse & myFile)
     
     
     
    'Procédure à exécuter ici:
       '[INSÉRER LE CODE À EXÉCUTER POUR CHAQUE DOCUMENT]
     
        'Next file in folder
     
        myFile = Dir$()
     
    Wend
     
    WordBasic.DisableAutoMacros 0   'Enables auto macros
     
        On Error GoTo 0 ' resume normal error handling
     
    End Sub
    Bonne chance!

    Souriane
    __________________________________
    Une question bien posée est à moitié résolue!

    Merci de ne pas oublier de mettre RÉSOLU quand le sujet l'est. Cela aide tous les DVPnautes dans leur recherche

  3. #3
    Nouveau membre du Club
    Homme Profil pro
    activités diverses et variées
    Inscrit en
    juillet 2013
    Messages
    24
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Belgique

    Informations professionnelles :
    Activité : activités diverses et variées

    Informations forums :
    Inscription : juillet 2013
    Messages : 24
    Points : 26
    Points
    26

    Par défaut

    merci pour la réponse. J'ai avancé un peu

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    Sub AllégerFichiers()
     
    Dim sPath As String, sFilename As String
    Dim objWord As New Word.Application
    Dim WordDoc As Word.Document
     
    Application.ScreenUpdating = False
     
    sPath = "C:\temp\"
     
    sFilename = Dir(sPath & "*.doc*")
     
    Do While Len(sFilename) > 0
     
        Set WordDoc = objWord.Documents.Open(sPath & sFilename)
        objWord.Visible = True
        objWord.Activate
     
     
    UnprotectVBProject WordDoc, "toto"
     
    For Each VbComp In WordDoc.VBProject.VBComponents
            Select Case VbComp.Type
                Case 1 To 3
                    WordDoc.VBProject.VBComponents.Remove VbComp
                Case Else
                    With VbComp.CodeModule
                    .DeleteLines 1, .CountOfLines
                    End With
            End Select
        Next VbComp
     
    WordDoc.Close True
     
    sFilename = Dir
     
    Loop
     
    Application.ScreenUpdating = True
    objWord.Quit
     
    End Sub
    J'ai fait des tests concluants mais la ligne :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    UnprotectVBProject WordDoc, "toto"
    me renvoie une erreur de compilation "Sub ou Fonction non définie"...

    merci pour votre aide!

  4. #4
    Expert éminent

    Homme Profil pro
    Développeur Vba Excel
    Inscrit en
    avril 2013
    Messages
    2 315
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Ille et Vilaine (Bretagne)

    Informations professionnelles :
    Activité : Développeur Vba Excel
    Secteur : High Tech - Éditeur de logiciels

    Informations forums :
    Inscription : avril 2013
    Messages : 2 315
    Points : 6 082
    Points
    6 082
    Billets dans le blog
    19

    Par défaut

    Citation Envoyé par article50 Voir le message
    Bonjour,

    UnprotectVBProject est une fonction. Elle permet de simuler les touches correspondant à la chaîne du mot de passe. Cette fonction est-elle présente dans un de vos modules ?

    Par ailleurs "Toto" est le mot de passe du / des documents. Dans votre code, cela suppose que tous vos documents ont le même mot de passe.
    Eric KERGRESSE
    https://sites.google.com/site/erickergresseeirl/
    Lorsque vous avez la réponse à votre question, n'oubliez pas de cliquer sur et si celle-ci est pertinente pensez à voter

  5. #5
    Nouveau membre du Club
    Homme Profil pro
    activités diverses et variées
    Inscrit en
    juillet 2013
    Messages
    24
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Belgique

    Informations professionnelles :
    Activité : activités diverses et variées

    Informations forums :
    Inscription : juillet 2013
    Messages : 24
    Points : 26
    Points
    26

    Par défaut Envoyé par Eric KERGRESSE

    "Toto" est le mot de passe du / des documents. Dans votre code, cela suppose que tous vos documents ont le même mot de passe.
    Oui c'est correct!

    UnprotectVBProject est une fonction. Elle permet de simuler les touches correspondant à la chaîne du mot de passe. Cette fonction est-elle présente dans un de vos modules ?
    Grâce à votre observation, j'ai rajouté ceci :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    Public Sub UnprotectVBProject(Wdc As Document, ByVal Pwd As String)
     
    Dim vbProj As Object
    Set vbProj = Wdc.VBProject
    If vbProj.Protection <> 1 Then Exit Sub
    Set Application.VBE.ActiveVBProject = vbProj
    SendKeys Pwd & "~~"
    Application.VBE.CommandBars(1).FindControl(ID:=2578, recursive:=True).Execute
     
    End Sub
    Maintenant quand je lance la macro, Word 2013 "cesse de fonctionner" et me propose des récupérations de fichiers

  6. #6
    Expert éminent

    Homme Profil pro
    Développeur Vba Excel
    Inscrit en
    avril 2013
    Messages
    2 315
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Ille et Vilaine (Bretagne)

    Informations professionnelles :
    Activité : Développeur Vba Excel
    Secteur : High Tech - Éditeur de logiciels

    Informations forums :
    Inscription : avril 2013
    Messages : 2 315
    Points : 6 082
    Points
    6 082
    Billets dans le blog
    19

    Par défaut

    Citation Envoyé par article50 Voir le message
    Cette fonction ne semble pas complète :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
     
    Function UnprotectVBProject(WB As Document, ByVal Password As String) As Boolean
    Dim vbProj As VBProject
     
    Set vbProj = WB.VBProject
     
    'Inutile si le projet est déjà déprotégé
    If vbProj.Protection <> 1 Then
        UnprotectVBProject = True
        Set vbProj = Nothing
        Exit Function
    Else
     
        Set Application.VBE.ActiveVBProject = vbProj
        'vbproj.Collection
        'Saisie du mot de passe avec SendKeys, {ESC} sort de la fenêtre de saisie du mot de passe
        SendKeys Password & "~~" & "{ESC}"
        Application.VBE.CommandBars(1).FindControl(ID:=2578, recursive:=True).Execute
        If vbProj.Protection <> 1 Then
            UnprotectVBProject = True
        Else
            'Password n'est pas le bon
            UnprotectVBProject = False
            SendKeys "%{F11}", True
        End If
    End If
    End Function
    Dans ma version, elle nécessite de cocher la référence Microsoft Visual Basic For Application Extensibility 5.3 (ou autre version pour 2013, je suis sur 2010)

    Par ailleurs, dans votre code principal, il vous faudra sans doute mettre un

    après cette fonction.
    Eric KERGRESSE
    https://sites.google.com/site/erickergresseeirl/
    Lorsque vous avez la réponse à votre question, n'oubliez pas de cliquer sur et si celle-ci est pertinente pensez à voter

  7. #7
    Expert éminent

    Homme Profil pro
    Développeur .NET
    Inscrit en
    janvier 2012
    Messages
    3 794
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 61
    Localisation : Canada

    Informations professionnelles :
    Activité : Développeur .NET
    Secteur : Finance

    Informations forums :
    Inscription : janvier 2012
    Messages : 3 794
    Points : 7 741
    Points
    7 741
    Billets dans le blog
    17

    Par défaut

    Bonjour,

    Si tu n'as pas besoin de rouvrir tes fichiers doc avec Word 2003 ou un Word précédent, un moyen simple de te débarrasser des macros c'est, du moins en théorie, d'enregistrer tes documents en docx, avec saveas.
    À ma connaissance, le seul personnage qui a été diagnostiqué comme étant allergique au mot effort. c'est Gaston Lagaffe.

    À force de vouloir considérer les utilisateurs comme des imbéciles patentés, on risque de se mettre dans le trouble.

    Excel n'a jamais été, n'est pas et ne sera jamais un SGBD, c'est pour cela que Excel s'appelle Excel et ne s'appelle pas Access junior.

  8. #8
    Nouveau membre du Club
    Homme Profil pro
    activités diverses et variées
    Inscrit en
    juillet 2013
    Messages
    24
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Belgique

    Informations professionnelles :
    Activité : activités diverses et variées

    Informations forums :
    Inscription : juillet 2013
    Messages : 24
    Points : 26
    Points
    26

    Par défaut

    Eric KERGRESSE
    Merci bcp pour le code complété. Mais voilà, rien n'y fait.. Word crash systématiquement Voici ce qu'il m'indique comme info :

    Informations supplémentaires sur le problème :
    LCID: 1036
    Brand: Office11Crash
    skulcid: 1036
    Certainement dû aux Senkeys je suppose. Je sens que je vais capituler ..

  9. #9
    Nouveau membre du Club
    Homme Profil pro
    activités diverses et variées
    Inscrit en
    juillet 2013
    Messages
    24
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Belgique

    Informations professionnelles :
    Activité : activités diverses et variées

    Informations forums :
    Inscription : juillet 2013
    Messages : 24
    Points : 26
    Points
    26

    Par défaut nouvelle approche

    Bonjour Eric, Clément, Souriane,
    Merci encore une fois pour vos messages très utiles.
    Voici le code que j'utilise pour recréer mes fichiers .doc sans macros. Il fonctionne!

    Pouvez-vous m'aider à l'adapter de manière à ce qu'il traite aussi les sous-dossiers ?

    Bon dimanche

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    Private Declare Function CloseClipboard Lib "user32" () As Long
    Private Declare Function EmptyClipboard Lib "user32" () As Long
     
    Sub FichiersSansMacros()
     
    Dim sPath As String, sFilename As String
    Dim objWord As New Word.Application
    Dim WordDoc As Word.Document
    Application.ScreenUpdating = False
     
    sPath = "C:\temp\"
     
    sFilename = Dir(sPath & "*.doc*")
     
    Do While Len(sFilename) > 0
     
        Set WordDoc = objWord.Documents.Open(sPath & sFilename)
        objWord.Visible = True
     
        objWord.Selection.WholeStory
        objWord.Selection.Copy
        Documents.Add DocumentType:=wdNewBlankDocument
        Selection.PasteAndFormat (wdPasteDefault)
     
        Call PressePapier
        WordDoc.Close True
     
    Dim oFSO As Scripting.FileSystemObject
    Dim oFl As Scripting.File
    Set oFSO = New Scripting.FileSystemObject
          oFSO.DeleteFile sPath & sFilename, False
     
        ChangeFileOpenDirectory sPath
        ActiveDocument.SaveAs FileName:=sPath & Left(sFilename, Len(sFilename) - 3) & "doc"
        ActiveDocument.Close
     
    sFilename = Dir
     
    Loop
     
    Application.ScreenUpdating = True
    objWord.Quit
     
    End Sub
     
    Private Sub PressePapier()
        OpenClipboard 0
        EmptyClipboard
        CloseClipboard
    End Sub

  10. #10
    Expert éminent

    Homme Profil pro
    Développeur Vba Excel
    Inscrit en
    avril 2013
    Messages
    2 315
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Ille et Vilaine (Bretagne)

    Informations professionnelles :
    Activité : Développeur Vba Excel
    Secteur : High Tech - Éditeur de logiciels

    Informations forums :
    Inscription : avril 2013
    Messages : 2 315
    Points : 6 082
    Points
    6 082
    Billets dans le blog
    19

    Par défaut

    Citation Envoyé par article50 Voir le message
    Bonjour,

    Il est inutile de créer une nouvelle session Word. Un exemple de traitement récursif :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
     
    Sub FichiersSansMacros()
     
    Dim fso As New Scripting.FileSystemObject
    Dim Dossier As Folder
    Dim SousRep As Folder
    Dim sPath As String, sFilename As String
    Dim WordDoc As Document
     
     
            sPath = "C:\Users\......"
     
            Set Dossier = fso.GetFolder(sPath)
            ' Application.ScreenUpdating = False
     
            ' Traitement récursif des sous dossiers
            For Each SousRep In Dossier.SubFolders
     
                 sFilename = Dir$(SousRep.Path & "\*.doc*")
     
                 Do While sFilename <> ""
     
                     Set WordDoc = Documents.Open(SousRep.Path & "\" & sFilename)
                     MsgBox "Sous répertoire en cours : " & SousRep.Name &  Chr(10)  &  "Chemin sous répertoire : " & SousRep.Path & Chr(10) &  "Document en cours : " & WordDoc.Name
                     WordDoc.Close True
                     Set WordDoc = Nothing
                     sFilename = Dir
     
                 Loop
     
            Next SousRep
            'Application.ScreenUpdating = True
     
           Set Dossier = Nothing
           Set fso = Nothing
     
    End Sub
    Eric KERGRESSE
    https://sites.google.com/site/erickergresseeirl/
    Lorsque vous avez la réponse à votre question, n'oubliez pas de cliquer sur et si celle-ci est pertinente pensez à voter

  11. #11
    Nouveau membre du Club
    Homme Profil pro
    activités diverses et variées
    Inscrit en
    juillet 2013
    Messages
    24
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Belgique

    Informations professionnelles :
    Activité : activités diverses et variées

    Informations forums :
    Inscription : juillet 2013
    Messages : 24
    Points : 26
    Points
    26

    Par défaut

    Merci beaucoup Eric KERGRESSE! Je suis arrivé à mon but et j'ai appris de nouvelles choses grâce à ton aide.

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. Réponses: 2
    Dernier message: 30/06/2016, 12h23
  2. Réponses: 7
    Dernier message: 08/06/2009, 12h41
  3. [Source]Supprimer par code des lignes de codes ou un Module
    Par mortalino dans le forum Macros et VBA Excel
    Réponses: 5
    Dernier message: 27/01/2007, 16h37

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo