Problème macro (garder les couleurs de fond)

  • Initiateur de la discussion Initiateur de la discussion eduraiss
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

eduraiss

XLDnaute Accro
Bonjour le forum

voici la macro ci-dessous me permet sur une plage de cellule de copie une mise en forme conditionnel 'texte)ainsi que les bordures

Mon problème est que dans cette plage j'ai des cellules de couleur différente, je ne parle pas de la couleur texte mais du fond
j'aurais aimer les conserver sans que cela les effaces lorsque je déclanche la macro
Merci de votre aide

Private Sub CommandButton20_Click()
Application.ScreenUpdating = False
Range("L3").Select
Selection.Copy

Range("C4:C11,E4:E11,G4:G11").Select
Range("G4").Activate

Range("C4:C11,E4:E11,G4:G11,C14:C34,E14:E34,G14:G34").Select
Range("G14").Activate

Range("C4:C11,E4:E11,G4:G11,C14:C34,E14:E34,G14:G34,C37:C61").Select
Range("C37").Activate

Range( _
"C4:C11,E4:E11,G4:G11,C14:C34,E14:E34,G14:G34,C37:C61,E37:E61,G37:G61,I53:J61") _
.Select
Range("I53").Activate

Range( _
"C4:C11,E4:E11,G4:G11,C14:C34,E14:E34,G14:G34,C37:C61,E37:E61,G37:G61,I53:J61,C65:C95" _
).Select
Range("C65").Activate

Range( _
"C4:C11,E4:E11,G4:G11,C14:C34,E14:E34,G14:G34,C37:C61,E37:E61,G37:G61,I53:J61,C65:C95,E65:E95" _
).Select
Range("E65").Activate

Range( _
"C4:C11,E4:E11,G4:G11,C14:C34,E14:E34,G14:G34,C37:C61,E37:E61,G37:G61,I53:J61,C65:C95,E65:E95,G65:G95" _
).Select
Range("G65").Activate

Range( _
"C4:C11,E4:E11,G4:G11,C14:C34,E14:E34,G14:G34,C37:C61,E37:E61,G37:G61,I53:J61,C65:C95,E65:E95,G65:G95,C98:C123" _
).Select
Range("C98").Activate

Range( _
"C4:C11,E4:E11,G4:G11,C14:C34,E14:E34,G14:G34,C37:C61,E37:E61,G37:G61,I53:J61,C65:C95,E65:E95,G65:G95,C98:C123,E98:E123" _
).Select
Range("E98").Activate

Range( _
"C4:C11,E4:E11,G4:G11,C14:C34,E14:E34,G14:G34,C37:C61,E37:E61,G37:G61,I53:J61,C65:C95,E65:E95,G65:G95,C98:C123,E98:E123,G98:G123,I115:J123" _
).Select
Range("I115").Activate
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

Range("C4").Select

Range("B3:H11").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlDash
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
'ActiveWindow.SmallScroll Down:=6
Range("B13:H34").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlDash
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
'ActiveWindow.SmallScroll Down:=27
Range("B36:H61").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlDash
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Range("B64:H95").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlDash
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

Range("B97:H123").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlDash
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

Range("I4:J61").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlDash
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

Range("I65:J123").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlDash
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Range("C3").Select
Unload Me
End Sub
 
Re : Problème macro (garder les couleurs de fond)

Bonsoir


Tu pourrais raccourcir ton code qui fleure bon l'enregisteur de macros

Ainsi ton code serait plus lisible.

Je reviens avec un code raccourci

Voila un début

Le principe est d'éviter les selet et activate

Je te laisse continue et tester
Code:
Application.ScreenUpdating = False
Range("L3").Copy
Range("C4:C11,E4:E11,G4:G11,C14:C34,E14:E34,G14:G34,C37:C61,E37:E61,G37:G61,I53:J61,C65:C95,E65:E95,G65:G95,C98:C123,E98:E123,G98:G123,I115:J123" _
).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
With Range("B3:H11").Borders
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
 
.....
 
Dernière édition:
Re : Problème macro (garder les couleurs de fond)

Re

En résumé que veux-tu faire:


Coller la valeur(seule) de la cellule L3
dans une selection mutiple

puis appliquer un format (bordure/couleur de fond)

C'est bien cà?

Voir explications ci dessous
Code:
Sub Macro2()
Selection.Copy
[COLOR=seagreen]'Range("A1:A100").Copy 'est à privilégier on évite la sélection[/COLOR]
[COLOR=seagreen]'ici on copie seulement la valeur[/COLOR]
Range("D1").PasteSpecial [B]Paste:=xlValues[/B], Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
[COLOR=seagreen]'ici on copie tout[/COLOR]
Range("F1").PasteSpecial [B]Paste:=xlAll[/B], Operation:=xlNone, SkipBlanks:=False _
, Transpose:=False
[COLOR=seagreen]'ici on copie uniquement le format[/COLOR]
Range("H1").PasteSpecial [B]Paste:=xlFormats[/B], Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
End Sub
 
Dernière édition:
Re : Problème macro (garder les couleurs de fond)

Re

en L3 je copie une forme conditionnel en ecriture "a/toto" doit être ecrit en rouge "r/titi" doit être ecrit en vert une fois cette cellule copie je la cole sur ma feuille a plusieurs endroit et je refait la bordure des cellules

J'ai des cellules de différentes couleur (fond de cellule bleu jaune vert rouge) le fait de declache la macro m'enlève ses fonds de couleur ce qui me pose problème

en gros je veux copier une mise ne forme conditionnel sans enlever le fond des cellules

Merci
 
Re : Problème macro (garder les couleurs de fond)

Re


Il me semble qu'un format conditionnel prime sur une couleur de fond
faite manuellement

C'est donc normal que si tu copies un format conditionnel, les couleurs de fond originelles soient effacées.

(A vérifier dans l'aide Excel, c'est fait)
Lu dans l'aide d'Excel
Vous pouvez spécifier jusqu'à trois conditions. Si aucune des conditions spécifiées n'est vraie, les cellules conservent leurs mises en forme existantes. Vous pouvez utiliser ces dernières pour identifier une quatrième condition
.
Donc j'en déduis que dès qu'une ondition est vrai le format conditionel annule le précédent
format

Pourrais-tu joindre, stp, un fichier exemple (en otant les données confidentielles)?
 
Dernière édition:
Re : Problème macro (garder les couleurs de fond)

Re

J'envisagerai le problème sous cet
angle

Nommer tes plages cellules devant recevoir le format condtionnel

Voir ci-dessous
Code:
Sub Macro8()
'Plage nommée PetriNOMS = C3:C10
Range("PetriNOMS").Select
With Selection
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=GAUCHE(C3;2)=""A/"""
.FormatConditions(1).Font.Bold = True
.FormatConditions(1).Font.Italic = False
.FormatConditions(1).Font.ColorIndex = 3
 
.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=GAUCHE(C3;2)=""M/"""
.FormatConditions(2).Font.Bold = True
.FormatConditions(2).Font.Italic = False
.FormatConditions(2).Font.ColorIndex = 5
 
.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=GAUCHE(C3;2)=""R/"""
.FormatConditions(3).Font.Bold = True
.FormatConditions(3).Font.Italic = False
.FormatConditions(3).Font.ColorIndex = 50
End With
End Sub
 
Re : Problème macro (garder les couleurs de fond)

Bonjour le forum


merci a toi mais pour faire les bordures dans la même macro est ce possible en selectionnant la plage par exemple petrinoms? ou alors je demarre avec mon code bordure et je fini par le tiens

Merci encore

A+
 
Re : Problème macro (garder les couleurs de fond)

Re

A tester (et à contnue pour les autres palges nommées
Code:
Sub formcondit()
Application.ScreenUpdating = False
[PetriNOMSMATIN].Copy
[PetriNOMAMidi].PasteSpecial xlFormats, xlNone, False, False
[PetriNOMSNUIT].PasteSpecial xlFormats, xlNone, False, False
Application.CutCopyMode = False
Range("C3:C10,E3:E10,G3:G10").Select
Call Bordures
End Sub
Sub Bordures()
With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlDash
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlDash
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
End Sub
 
Re : Problème macro (garder les couleurs de fond)

Re

Voici le code commenté
Code:
Sub formcondit()
Application.ScreenUpdating = False
[COLOR=seagreen]' désactive le rafraichissement écran[/COLOR]
[PetriNOMSMATIN].Copy
[COLOR=seagreen]'copie la page nommée PetriNOMSMATIN[/COLOR]
[PetriNOMAMidi].PasteSpecial xlFormats, xlNone, False, False
[COLOR=seagreen]'colle le format uniquement (inclu le format conditionnel[/COLOR]
[COLOR=seagreen]'dans la plage nommée PetriNOMAMidi
[/COLOR][PetriNOMSNUIT].PasteSpecial xlFormats, xlNone, False, False
[COLOR=seagreen]'idem mais dans la plage nommée PetriNOMSNUIT
[/COLOR]Application.CutCopyMode = False
Application.CutCopyMode = True
[Lign3NOMSMatin].Copy
[COLOR=seagreen]'on recomence le collage/format pour les autres palges nommées[/COLOR]
'Lign3AMIDI,Lign3NUIT
[Lign3AMIDI].PasteSpecial xlFormats, xlNone, False, False
[Lign3NUIT].PasteSpecial xlFormats, xlNone, False, False
Application.CutCopyMode = False
[COLOR=seagreen]'on appelle la macro Bordure 
[/COLOR]Call Bordure
End Sub
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
14
Affichages
484
M
Réponses
8
Affichages
2 K
Michelrib
M
T
  • Question Question
XL pour MAC Recherche date
Réponses
5
Affichages
2 K
tdenis
T
D
Réponses
1
Affichages
675
Compte Supprimé 979
C
L
Réponses
9
Affichages
1 K
S
Réponses
4
Affichages
2 K
stage_ferrit
S
H
Réponses
2
Affichages
1 K
H
C
  • Question Question
Réponses
13
Affichages
3 K
C
Réponses
2
Affichages
1 K
candice**
C
Retour