IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Macro excel pour copier la mise en forme d'un document à plusieurs autres documents. [XL-2003]


Sujet :

Macros et VBA Excel

  1. #41
    Expert éminent
    Avatar de Qwazerty
    Homme Profil pro
    La très haute tension :D
    Inscrit en
    Avril 2002
    Messages
    3 898
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 43
    Localisation : France

    Informations professionnelles :
    Activité : La très haute tension :D
    Secteur : Service public

    Informations forums :
    Inscription : Avril 2002
    Messages : 3 898
    Points : 8 529
    Points
    8 529
    Par défaut
    Salut

    Le shape se nomme "Group 71".

    Par contre attention ça n'effacera que le texte "Paramètres standards" et le cadre noir. rien d'autre.

    Tu veux effacer quoi exactement ?

    Peux tu mettre le code que tu exécutes pour effacer (la sub complète) stp, je me demande si tu pointes bien le bon fichier pour travailler dessus, car il existe bien une shape Rectangle 31" donc ça ne devrait pas provoquer d'erreur de la pointer.

    Attention aussi, il faut que le shape porte toujours le même nom dans tous les fichiers que tu vas traiter...
    ++
    Qwaz

    MagicQwaz := Harry Potter la baguette en moins
    Le monde dans lequel on vit
    Ma page perso DVP
    Dernier et Seul Tutoriel : VBA & Internet Explorer
    Dernière contribution : Lien Tableau Structuré et UserForm
    L'utilisation de l’éditeur de message

  2. #42
    Membre à l'essai
    Homme Profil pro
    Ingénieur développement matériel électronique
    Inscrit en
    Juillet 2015
    Messages
    57
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 33
    Localisation : Canada

    Informations professionnelles :
    Activité : Ingénieur développement matériel électronique
    Secteur : High Tech - Électronique et micro-électronique

    Informations forums :
    Inscription : Juillet 2015
    Messages : 57
    Points : 17
    Points
    17
    Par défaut
    En fait je veux effacer justement le texte et le cadre puisque mon code copie/colle du contenu directement sur ces cellules (G17-L36)

    Voici le code complet :
    La "Zone_d_impression" c'est simplement un test, ça ne veut rien dire vraiment...

    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
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
     
    Option Explicit
     
    Const Pass As String = "0179"
     
    Sub Example()
            'Variables
        Dim MyPath As String, FilesInPath As String
        Dim MyFiles() As String, Fnum As Long
        Dim mybook As Workbook, xlsheet As Worksheet
        Dim CalcMode As Long, ErrorYes As Boolean
     
            'Change ScreenUpdating, Calculation and EnableEvents
        With Application
            CalcMode = .Calculation
            .Calculation = xlCalculationManual
            .ScreenUpdating = False
            .EnableEvents = False
        End With
     
            'Dim ActiveWorksheet As Worksheet
        Set xlsheet = ThisWorkbook.Worksheets("Paramètres")
     
            'Fill in the path\folder where the files are
        MyPath = "C:\Documents and Settings\apoirierrouillard\Bureau\TestVBA\Test2VBA"
     
            'Add a slash at the end if the user forget it
        If Right(MyPath, 1) <> "\" Then
            MyPath = MyPath & "\"
        End If
     
        'If there are no Excel files in the folder exit the sub
        FilesInPath = Dir(MyPath & "*.xl*")
        If FilesInPath = "" Then
            MsgBox "No files found"
            Exit Sub
        End If
     
        'Fill the array(myFiles)with the list of Excel files in the folder
        Fnum = 0
        Do While FilesInPath <> ""
            Fnum = Fnum + 1
            ReDim Preserve MyFiles(1 To Fnum)
            MyFiles(Fnum) = FilesInPath
            FilesInPath = Dir()
        Loop
     
        'Loop through all files in the array(myFiles)
     
            For Fnum = LBound(MyFiles) To UBound(MyFiles)
     
                Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum))
     
                        'Change cell value(s) in one worksheet in
     
                        With ThisWorkbook.Worksheets(1)
                            If .ProtectContents = True Then .Unprotect Password:=Pass
                        End With
     
                        With mybook.Worksheets(1)
                            If .ProtectContents = True Then .Unprotect Password:=Pass
                        End With
     
                         With mybook.Worksheets(1)
                         .Shapes("Zone_d_impression").Delete
                        End With
     
                        With mybook.Worksheets(1)
                            ThisWorkbook.Worksheets(1).Range("G17:L36").Copy .Range("G17:L36")
                            .Protect Password:=Pass
                        End With
     
                        'Save and close mybook
                        mybook.Close savechanges:=True
                    Next Fnum
     
        'Restore ScreenUpdating, Calculation and EnableEvents
        With Application
            .ScreenUpdating = True
            .EnableEvents = True
            .Calculation = CalcMode
        End With
    End Sub

  3. #43
    Membre à l'essai
    Homme Profil pro
    Ingénieur développement matériel électronique
    Inscrit en
    Juillet 2015
    Messages
    57
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 33
    Localisation : Canada

    Informations professionnelles :
    Activité : Ingénieur développement matériel électronique
    Secteur : High Tech - Électronique et micro-électronique

    Informations forums :
    Inscription : Juillet 2015
    Messages : 57
    Points : 17
    Points
    17
    Par défaut
    J'ai trouvé le problème.

    Dans mon dossier où mes fichiers destination se trouvent, il y a que quelques fichiers qui ont le "Group 71" comme shape... Donc lorsque le programme ne trouvent pas la shape il donne l'erreur... Y aurait-il une boucle condition (if) pour détecter la présence de Group 71 ? Je pose la question et je cherche sur le net en même temps

    EDIT : Je fais un test, si je mets "On Error Resume Next" ça devrait fonctionner ! Je vous redonne des nouvelles

    Merci les amis

    Voilà Tout est fonctionnel ! Merci à tous les participants qui m'ont aidé, c'est vraiment apprécié !

    Je marque résolu

  4. #44
    Expert éminent
    Avatar de Qwazerty
    Homme Profil pro
    La très haute tension :D
    Inscrit en
    Avril 2002
    Messages
    3 898
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 43
    Localisation : France

    Informations professionnelles :
    Activité : La très haute tension :D
    Secteur : Service public

    Informations forums :
    Inscription : Avril 2002
    Messages : 3 898
    Points : 8 529
    Points
    8 529
    Par défaut
    Salut

    Attention avec le "On error resume Next", ça désactive le gestionnaire d'erreur, donc s'il y a une erreur dans un autre morceau du code tu ne seras plus alerté et le code peut se mettre à faire n'importe quoi.

    Soit tu fais une gestion d'erreur, en plaçant un code qui ressemble à ça (peut sans doute être amélioré
    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
    Sub gestionErreur()
    On Error GoTo GestionErr
     
    '... Code
     
    Feuil1.Shapes("Groupe 71").Delete
     
    '... cOde
     
    Exit Sub
     
    GestionErr:
     
    'Si manque Groupe 71
    If Err.Number = -2147024809 Then
        Resume Next
    Else 'Si une autre erreur
        'On affiche le message d'erreur type
        Err.Raise Err.Number
    End If
    End Sub
    Soit l'utilisation du On Error Resume Next comme cela
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    Sub gestionErreur2()
     
    '... Code
    On Error Resume Next 'désactive la gestion d'erreur
    Feuil1.Shapes("Groupe 71").Delete
    On Error GoTo 0 'réactive la gestion d'erreur
     
    '... cOde
    End Sub
    ++
    Qwaz

    MagicQwaz := Harry Potter la baguette en moins
    Le monde dans lequel on vit
    Ma page perso DVP
    Dernier et Seul Tutoriel : VBA & Internet Explorer
    Dernière contribution : Lien Tableau Structuré et UserForm
    L'utilisation de l’éditeur de message

+ Répondre à la discussion
Cette discussion est résolue.
Page 3 sur 3 PremièrePremière 123

Discussions similaires

  1. [XL-2010] copier/coller mise en forme d'un graphe excel
    Par awa123 dans le forum Excel
    Réponses: 1
    Dernier message: 09/01/2015, 15h32
  2. Réponses: 0
    Dernier message: 17/11/2012, 18h51
  3. Macro pour copier sans mise en forme
    Par oligig dans le forum VBA Word
    Réponses: 11
    Dernier message: 07/12/2011, 23h33
  4. [VBA EXCEL]: Savoir si une mise en forme conditionnelle est active
    Par ADONET dans le forum Macros et VBA Excel
    Réponses: 3
    Dernier message: 03/01/2007, 15h59
  5. Aide sur les macros Excel pour recopie auto de données
    Par nicoduhavre dans le forum Macros et VBA Excel
    Réponses: 4
    Dernier message: 15/11/2005, 09h38

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