Modification couleur de fond et de texte dans une macro d'archivage

Bonjour à tous,

J'ai besoin de votre aide car je suis bloqué sur ma macro d'archivage.

Pour vous mettre dans le contexte, ma macro me permets d'enregistrer le fichier découverte clients dans un dossier à son nom puis de mettre à jour le fichier en réinitialisant toutes les cellules de ce fichier.

Mais en testant mon fichier je me suis rendue compte d'un petit souci. En effet, la cellule E35 me permet de dire si l'adresse des travaux est la même que l'adresse de facturation si c'est le cas alors la cellule E37 renvoie les données de la cellule E14 et la cellule E39 renvoie les données de la cellule E16 grâce à une formule écrite en E37 et en E39. Si ce n'est pas le cas alors je renseigne la nouvelle adresse dans E37 et E39 ce qui à pour résultat d'effacer les formules respectives de ces cellules. J'ai donc réécris les formules dans les cellules précédentes de chacune (E36 et E38) et ajouté des lignes de code pour que la cellule E36 soit copier en E37 et la cellule E38 en E39. Cela fonctionne Mais cela copie également les caractéristiques de ces cellules, j'ai donc rajouté des lignes de code pour modifier la couleur du texte ( mettre en noir), le fond de la cellule (mettre en blanc) ainsi que d'encadrer ces cellules avec un cadre fin noir et la ça ne fonctionne plus . Ma macro ne s'applique plus comme il faut car elle ferme le fichier sans m'informer de la mise à jour du fichier, ce qu'elle faisait avant que j'ajoute ces lignes.

Je vous joins mon code car je n'arrive pas à sortir le fichier.

Merci d'avance pour votre aide.

tissaraz

Sub Archivage()

'Déclaration des variables:
    Dim NomDossier As String
    Dim CheminDossier As String

    On Error GoTo 1

'Je désactive la protection de la feuille:
    ActiveSheet.Unprotect
'Je désactive les messages d'alerte:
    Application.DisplayAlerts = False

'Je test que le nom du client à bien été saisie ou pas:

    If IsEmpty(Range("E10")) = True Then
        MsgBox "***Attention*** Vous n'avez pas renseigné le nom du client." & vbCrLf & _
        "Merci de faire le necessaire avant de sauvegerder le fichier", vbOKOnly

    Range("E10").Select

   'Sinon
    Else

    'création d'un dossier avec le nom de la cellule E10
        MkDir "E:\x\y\LE_SERVICE_POSE\DOSSIERS_DE_POSE\" & Range("E10")

        With ActiveWorkbook 'fonction activeworkbook ne fonctionne pas en mode protégé.

    'Enregistrement du classeur portant le nom de la cellule E10 dans le dossier créé au dessus
        Nom = "E:\x\y\LE_SERVICE_POSE\DOSSIERS_DE_POSE\" & Range("E10")
        .SaveAs Filename:=Nom & "\" & "FORMULAIRE " & Range("E10"), FileFormat:=xlOpenXMLWorkbookMacroEnabled

        End With

    'Je selectionne une plage de cellules que je réinitialise:

        If Range("E10") <> "" Then
            Range("E8,E10,E12,E14,E16,E18,E20,E22,E24,E26,E28,E30").Select
            Selection.ClearContents
        End If

        If Range("E35") <> "" Then
            Range("E35,E37,E39,E41,E43,E45,E51,E53,E55,E57,E59,E61").Select
            Selection.ClearContents

            Range("E36").Copy Range("E37")
            Range("E37").Select
            'je modifie la couleur du texte et du fond de la cellule E37 en noir et blanc:
                Selection.Font.ColorIndex = RGB(0, 0, 0)
                Selection.Interior.Color = RGB(255, 255, 255)
            'j'ajoute une bordure autour de la cellule E37:
                ActiveCell.Borders.Weight = 1
                ActiveCell.Borders.Color = RGB(0, 0, 0)

            Range("E38").Copy Range("E39")
            Range("E39").Select
            'je modifie la couleur du texte et du fond de la cellule E39 en noir et blanc:
                Selection.Font.ColorIndex = RGB(0, 0, 0)
                Selection.Interior.Color = RGB(255, 255, 255)
            'j'ajoute une bordure autour de la cellule E39:
                ActiveCell.Borders.Weight = 1
                ActiveCell.Borders.Color = RGB(0, 0, 0)
         End If

        If Range("E66") <> "" Then
            Range("E66,E68,E70,E72,E74,E76,E78,E80,E92").Select
            Selection.ClearContents
        End If

        If Range("E99") <> "" Then
            Range("E99,E101,E119,E121,E123").Select
            Selection.ClearContents
        End If

        'On selectionne la première cellule du fichier
            Range("E8").Select

            If IsEmpty(Range("E8")) = True Then

                 With ThisWorkbook 'fonction activeworkbook ne fonctionne pas en mode protégé.

                'Enregistrement du classeur vierge.
                    .SaveAs Filename:="E:\x\y\LE_SERVICE_POSE\" & "FORMULAIRE DECOUVERTE", FileFormat:=xlOpenXMLWorkbookMacroEnabled

                End With

                'On affiche un message informant que le fichier a bien été sauvegardé.
                     MsgBox "Le fichier a bien été sauvegardé et le formulaire découverte a été mis a jour."

            End If

'Je réactive la gestion des alertes:
    Application.DisplayAlerts = True
'Je reprotège la feuille:
    ActiveSheet.Protect

1
'Je ferme le fichier:
    Application.Quit

    End If

End Sub

Bonsoir,

et plutôt que de copier la cellule si vous ne copiez que sa valeur : Range("E37")=Range("E36").Value ? Du coup les lignes de codes pour la modification de format ne sont plus utiles.

Sinon pour info, en VBA on peut "travailler" sur des cellules (ou plage) sans avoir besoin de les sélectionner, ceci accélère le code et c'est plus propre.
Voici une correction possible d'une partie de votre code :
à la place de :

        If Range("E10") <> "" Then
            Range("E8,E10,E12,E14,E16,E18,E20,E22,E24,E26,E28,E30").Select
            Selection.ClearContents
        End If

mettre :

        If Range("E10") <> "" Then
            Range("E8,E10,E12,E14,E16,E18,E20,E22,E24,E26,E28,E30").ClearContents
        End If

@ bientôt

LouReeD

Bonjour LouReeD,

J'ai appliqué les modifications que tu m'as suggéré mais cela ne fonctionne pas mon fichier ne réinitialise plus aucune cellules.

Je ne comprends pas pourquoi ce la fonctionne avec le .select mais pas avec la version simplifié.

Du coup je vais remettre la version .select au moins pour vérifier que le .value fonctionne comme il faut.

Aurais-tu une idée de ce qui cloche?

Je reviens vers toi dès que je l'ai testé.

Merci de ton aide

Tissaraz

Bonjour,

Après l'avoir testé ma théorie c'est avéré être fausse, que je mette le .select ou la version simplifié cela ne fonctionne plus.

Je ne comprends pas je n'ai pourtant rien changé à mon code d'origine.

avez vous des idées sur ce qui cloche? Je vais continuer de chercher de mon coté.

Tissaraz

rebonjour,

J'ai essayé plusieurs chose pour comprendre mais je reste dans le flou.

En mettant des MsgBox à chaque étape j'ai pu déterminer à partir de où ça coince et il se trouve que c'est sur la deuxième partie de la suppression. Quoique je fasse le MsgBox "2" n'apparaît pas et mon fichier ce ferme.

J'ai essayé de changer l'ordre des lignes, j'ai essayer de retirer les deux premières lignes pour voir si l'effacement des cellules fonctionneraient mais non!

J'avoue être à cours d'idées!!!

HELP ME !!!!!!!

 If Range("E10") <> "" Then
            Range("E8,E10,E12,E14,E16,E18,E20,E22,E24,E26,E28,E30").ClearContents
        End If
        MsgBox "1"

        If Range("E35") <> "" Then
            Range("E37") = Range("E36").Value
            Range("E39") = Range("E38").Value
            Range("E35,E41,E43,E45,E51,E53,E55,E57,E59,E61").ClearContents
        End If
        MsgBox "2"

Bonjour,

Vous devriez fournir votre fichier afin de comprendre ce qui se passe au niveau du code, mais avant il faut le rendre "anonyme" en fonction des données, voir en créer une copie "plus petite" pour qu'elle puisse "passer" sur le site.

@ bientôt

LouReeD

Bonjour,

Je vous joins mon fichier simplifié en espérant que cela pourra nous aider à résoudre mon problème.

J'ai essayé le .value mais ça ne correspond pas à ce dont j'ai besoin car vu que je réinitialise mes cellules la valeur affiché est 0 sauf que lorsque je veux le remplir à nouveau ma formule n'existe pas puisque ma cellule est égale à 0 et non à ma formule.

Me revoilà au point de départ avec mon .copy et ma modification de couleur du fond et du texte avec l'encadrement en plus qui ne fonctionne pas.

Merci d'avance pour votre aide

Tissaraz

Bonsoir,

un essai de tranformation :

    Range("E36").Copy
    Range("E37").PasteSpecial Paste:=xlPasteFormulas

En fait on copie, mais on ne colle que la formule

Avec un fichier c'est plus simple pour comprendre. A vous de me dire si cela convient !

@ bientôt

LouReeD

Bonjour,

J'ai testé le code et ça copie effectivement la formule, c'est cool ça avance. Comment puis-je faire pour que le texte de la formule soit en noir et pas en gris.

Lorsque je lance la macro, celle-ci s'arrête toujours après la copie, elle ne m'affiche pas le msgbox 2 et du coup ne réinitialise pas les cellules.

Aurais-tu une idée de ce qui bloque, parce que cela fonctionnait avant.

Tissaraz

Bonjour,

lors de la phase de développement d'une application il faut éviter de mettre des on Error Resume Next ou Goto, car ceci masque les erreurs et le type d'erreur rencontrées par le code. Ici lors de la copie de e36 ou la deuxième copie ou bien l'initialisation des cellules doit provoquer une erreur mais le code "obéit" à On Error Goto 1 et il va à "1" suite à l'erreur, la procédure est finie...

Mettez en commentaire le on error goto 1 et relancer la procédure, VBA vous indiquera le problème rencontré.

@ bientôt

LouReeD

Bonjour,

Il m'affiche en surbrillance la ligne

Range("E35,E41,E43,E45,E51,E53,E55,E57,E59,E61").ClearContents

Je n'ai pas l'impression d'avoir d'erreur dans cette ligne, est-il possible que la cellule E45 qui représente la fusion des cellules 45,46,47,48,49 pose problème? Dois-je l'écrire autrement?

Tissaraz

Bonsoir

essayez en mettant de 45 à 49 comme vous venez de l'écrire.

Sinon une solution simple c'est de sélectionner vos cellules, et de donner un "Jolinom" à cette sélection en utilisant le champ texte qui se trouve à gauche de la barre de formule.

Une fois ceci fait, dans le code VBA vous inscrivez : Range("Jolinom").ClearContents
A voir si cela passe mieux...

@ bientôt

LouReeD

Bonjour,

Alors si je mets toutes les cellules de E45 à E49 ça ne fonctionne pas, ma ligne reste en erreur.

Si je renomme la plage de cellule fusion1, que je supprime les cellules E45 à E49 et que j'ajoute la ligne Range("fusion1").ClearContents ça ne fonctionne pas non plus . La première ligne n'est plus en erreur mais celle que j'ai ajouté l'est.

J'ai essayé en défusionnant les cellules et en gardant uniquement la première ligne avec les cellules de E45 à E49. ÇA FONCTIONNE!!!!!!!!!!

J'aurai quand même préférer laisser mes cellules fusionnées pour une utilisation plus fluide.

Aurais-tu une idée?

Tissaraz

Bonjour,

Range("E35,E41,E43,E45:E49,E51,E53,E55,E57,E59,E61").ClearContents

@ bientôt

LouReeD

Bonjour,

Il s'avère que c'était si simple, j'aurai du y penser. Je ne me ferai pas avoir deux fois.

J'ai encore un point qui me chiffonne et je te laisse tranquille. Lorsque je copie ma formule E36 dans la cellule E37 celle ci garde la couleur grise de la cellule E36, comment faire pour la mettre en noir.

J'ai essayé la formule Range("E37").Font.Color=RGB(0,0,0) j'ai trouvé cette ligne de code dans le cours VBA de ce site.

Mais cette ligne ce met en erreur lorsque je lance la macro.Est-ce que je ne l'applique pas comme il faut?

Tissaraz

Bonjour,

Est-il possible que le problème vienne du fait que ce code ne fonctionne qu'avec une cellule pleine? La cellule ayant été réinitialisée elle est vide, s'il n'y a pas de texte dans la cellule le code se met en erreur car il ne trouve rien à modifier, est-ce possible? si c'est le cas, comment contourner ça? en plaçant la ligne de code à un autre endroit?

Tissaraz

Bonsoir,

l'instruction n'a pas besoin de texte pour changer le format de la cellule.
Par contre votre feuille a un code de surveillance événementielle de "Change", donc votre code modifie une cellule, c'est détecté par le code de surveillance qui se déroule plus ou moins, mais cela va au moins jusqu'à la remise en place de la protection de feuille, et là c'est le drame...
Donc soit vous ré enlever la protection de la feuille après chaque modification de cellule soit vous stopper en début de code les surveillance événementielles, pour ce faire il faut "juste" ajouter cette instruction en début de code : Application.EnableEvents = False et il ne faut surtout pas oublier de le remettre à True en fin de code sinon plus aucune activité sur la feuille ne sera détectée : Application.EnableEvents = True.

Quand j'utilise ce genre d'instruction sous Excel je me prépare une petite procédure de "récupération" :

Sub Oups()
    Application.EnableEvents = True
End Sub

Comme cela si ça plante avant le "True", sous VBA je le remet en place !

@ bientôt

LouReeD

Bonsoir LouReeD

Je te remercie pour tout ce que tu m'as appris, tout fonctionne comme il faut.

A bientôt

Tissaraz

Bonsoir,

merci de votre retour et de vos remerciements !

@ bientôt

LouReeD