Excel - macro mise en forme

stephy13 Messages postés 108 Statut Membre -  
stephy13 Messages postés 108 Statut Membre -
Bonjour,

Je souhaiterais copier la mise en forme de plusieurs cellules sous conditions.

Voici une capture d'écran par exemple : http://nsa15.casimages.com/img/2010/04/18/100418073930724976.jpg

Donc d'après ma formule, lorsque je met 1, 2, 3 ou 4 dans la cellule E1, dans la cellule E2 il apparaît A, B, C ou D. Le problème c'est que j'aimerais qu'il y ait la mise en forme de la lettre (A en rouge; B en vert souligné; C en bleu; D en orange souligné). Dois-je utiliser une macro? si oui laquelle? (je m'y connais pas du tout en macro)

Petite précision : dans la réalité le tableau en bleu se situe dans une autre page

Merci d'avance

5 réponses

funbreizhou Messages postés 89 Statut Membre 11
 
bonjour,

Ca se fait facilement avec les macros :

Sub A()
If Range("E1") = 1 Then
Range("E2").Select
ActiveCell.FormulaR1C1 = "A"
Range("E2").Select
With selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("E1").Select
ActiveWindow.SmallScroll Down:=15

End If

End Sub

ça par exemple ca serait pour avoir un A rouge et en gras dans la cellule E2 si E1 = 1.

Essaye de voir si t'arrives déjà à coller cette macro là où il faut
0
stephy13 Messages postés 108 Statut Membre 11
 
merci pour ta réponse, par contre je pense l'avoir collé au bon endroit (développeur --> enregistrer une macro (nom macro : A) --> développeur --> macro --> modifié --> ctrl + V) par contre je ne sais pas comment l'activer car là pour le moment ça ne marche pas. Merci
0
funbreizhou Messages postés 89 Statut Membre 11
 
tu fais ALT + F11, tu cliques sur "feuille1" en haut à gauche et tu colles tout. Après c'est à toi d'adapter les noms de cellules. j'ai essayé de suivre ton modèle mais j'ai pu me tromper.
0
funbreizhou Messages postés 89 Statut Membre 11
 
Sub format()

If Range("E1") = 1 Then

Range("E2").Select
selection.Font.Bold = True
With selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
selection.Font.ColorIndex = 3
selection.Font.Underline = xlUnderlineStyleSingle
selection.Font.Underline = xlUnderlineStyleNone
ActiveCell.FormulaR1C1 = "A"
Range("E3").Select
Else: GoTo suite

End If

suite:

If Range("E1") = 2 Then

Range("E2").Select
selection.Font.Bold = True
With selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
selection.Font.ColorIndex = 43
selection.Font.Underline = xlUnderlineStyleSingle
ActiveCell.FormulaR1C1 = "B"
Range("E3").Select

Else: GoTo suite2

End If

suite2:

If Range("E1") = 3 Then

Range("E2").Select
selection.Font.Bold = True
With selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
selection.Font.ColorIndex = 55
ActiveCell.FormulaR1C1 = "C"
Range("E2").Select
selection.Font.Underline = xlUnderlineStyleSingle
selection.Font.Underline = xlUnderlineStyleNone
Else: GoTo suite3

End If

suite3:

If Range("E1") = 4 Then

Range("E2").Select
selection.Font.Bold = True
With selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
selection.Font.ColorIndex = 45
selection.Font.Underline = xlUnderlineStyleSingle
ActiveCell.FormulaR1C1 = "D"
Range("E3").Select
Else
End If

End Sub

Voilà le code complet pour ce que t'as demandé.
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
stephy13 Messages postés 108 Statut Membre 11
 
Merci bcp funbreizhou :-)
0