VBA: changer de police selon critères
Résolu
Aline
-
ccm81 Messages postés 11033 Statut Membre -
ccm81 Messages postés 11033 Statut Membre -
Bonjour à tous (me again!),
Je sollicite une nouvelle fois votre aide étant amatrice plus que débutante dans le macro. Avec mes recherches sur les forums j'ai réussi à réaliser un semblant de macro qui comporte quelques erreurs que je n'arrivent pas à rectifier.
Pour info : dans mon tableau j'ai des noms assimilés à un chiffre selon leur importance et je souhaite que ma macro change la taille de la police selon ce même chiffre.
Merci d'avance pour votre aide!
Voici ce que je suis parvenue à faire:
Sub Mise_en_Forme()
Set rRange = Range(Columns(C), Columns(H), Columns(M), Columns(R), Columns(W))
If Range("C17,H17,M17,R17,W17").EntireColumn = 10 Then Call Macro1
If Range("C17,H17,M17,R17,W17").EntireColumn = 14 Then Call Macro2
If Range("C17,H17,M17,R17,W17").EntireColumn = 18 Then Call Macro3
If Range("C17,H17,M17,R17,W17").EntireColumn = 22 Then Call Macro4
If Range("C17,H17,M17,R17,W17").EntireColumn = 28 Then Call Macro5
End Sub
Sub Macro1()
Range("B17:B100,G17:G100,L17:L100, Q17:Q100, V17:V100").Select
With Selection.Font
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
End With
End Sub
Sub Macro2()
Range("B17:B100,G17:G100,L17:L100, Q17:Q100, V17:V100").Select
With Selection.Font
.Size = 14
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
End With
End Sub
Sub Macro3()
Range("B17:B100,G17:G100,L17:L100, Q17:Q100, V17:V100").Select
With Selection.Font
.Size = 18
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
End With
End Sub
Sub Macro4()
Range("B17:B100,G17:G100,L17:L100, Q17:Q100, V17:V100").Select
With Selection.Font
.Size = 22
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
End With
End Sub
Sub Macro5()
Range("B17:B100,G17:G100,L17:L100, Q17:Q100, V17:V100").Select
With Selection.Font
.Size = 28
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
End With
End Sub
Je sollicite une nouvelle fois votre aide étant amatrice plus que débutante dans le macro. Avec mes recherches sur les forums j'ai réussi à réaliser un semblant de macro qui comporte quelques erreurs que je n'arrivent pas à rectifier.
Pour info : dans mon tableau j'ai des noms assimilés à un chiffre selon leur importance et je souhaite que ma macro change la taille de la police selon ce même chiffre.
Merci d'avance pour votre aide!
Voici ce que je suis parvenue à faire:
Sub Mise_en_Forme()
Set rRange = Range(Columns(C), Columns(H), Columns(M), Columns(R), Columns(W))
If Range("C17,H17,M17,R17,W17").EntireColumn = 10 Then Call Macro1
If Range("C17,H17,M17,R17,W17").EntireColumn = 14 Then Call Macro2
If Range("C17,H17,M17,R17,W17").EntireColumn = 18 Then Call Macro3
If Range("C17,H17,M17,R17,W17").EntireColumn = 22 Then Call Macro4
If Range("C17,H17,M17,R17,W17").EntireColumn = 28 Then Call Macro5
End Sub
Sub Macro1()
Range("B17:B100,G17:G100,L17:L100, Q17:Q100, V17:V100").Select
With Selection.Font
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
End With
End Sub
Sub Macro2()
Range("B17:B100,G17:G100,L17:L100, Q17:Q100, V17:V100").Select
With Selection.Font
.Size = 14
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
End With
End Sub
Sub Macro3()
Range("B17:B100,G17:G100,L17:L100, Q17:Q100, V17:V100").Select
With Selection.Font
.Size = 18
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
End With
End Sub
Sub Macro4()
Range("B17:B100,G17:G100,L17:L100, Q17:Q100, V17:V100").Select
With Selection.Font
.Size = 22
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
End With
End Sub
Sub Macro5()
Range("B17:B100,G17:G100,L17:L100, Q17:Q100, V17:V100").Select
With Selection.Font
.Size = 28
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
End With
End Sub
2 réponses
-
Bonjour Aline,
Fichier Excel 2007 : https://mon-partage.fr/f/rfXrEgwq/
Ctrl e => travail fait
Alt F11 pour voir la macro, puis revenir sur Excel
Bien sûr, dans ton vrai fichier, tu devras adapter la macro
selon l'emplacement réel de tes données.
Merci de me dire si ça te convient.
Cordialement
-
Bonjour Grégoire,
Je n'arrive malheureusement pas à avoir accès à ton lien, peux-tu me faire une capture écran de la macro stp ?
Bonjour Aline,
Sur la feuille de calcul :
A B 1 A 10 2 B 14 3 C 18 4 D 22 5 E 28 6 F 14 7 G 10
Voici le code VBA :
Option Explicit Sub Essai() Dim dlig As Long, lig As Long dlig = Range("A" & Rows.Count).End(xlUp).Row For lig = 1 To dlig Cells(lig, 1).Font.Size = Cells(lig, 2) Next lig End Sub
Bien sûr, dans ton vrai fichier, tu devras adapter la macro
selon l'emplacement réel de tes données.
Si besoin, tu peux me demander une adaptation
ou un complément d'infos.
Cordialement
-
-
-
Bonjour à tous les deux
Si tu veux que la taille de la police soit égale à la valeur de la celluleSub Mise_en_Forme() Dim cel As Range, t As Byte, plage As Range Set plage = Union(Range("C17"), Range("H17"), Range("M17"), Range("R17"), Range("W17")) For Each cel In plage t = cel.Value cel.Font.Size = t Next cel End Sub
Cdlmnt