VBA: changer de police selon critères
Résolu
Aline
-
ccm81 Messages postés 10909 Date d'inscription Statut Membre Dernière intervention -
ccm81 Messages postés 10909 Date d'inscription Statut Membre Dernière intervention -
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
A voir également:
- VBA: changer de police selon critères
- Excel compter cellule couleur sans vba - Guide
- Incompatibilité de type vba ✓ - Forum VB / VBA
- Erreur 13 incompatibilité de type VBA excel ✓ - Forum Excel
- Mkdir vba ✓ - Forum VB / VBA
- Dépassement de capacité vba ✓ - Forum Excel
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
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 à tous les deux
Si tu veux que la taille de la police soit égale à la valeur de la cellule
Cdlmnt
Si tu veux que la taille de la police soit égale à la valeur de la cellule
Sub 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
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 :
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 SubBien 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
Je viens de réussir à terminer ma macro merci beaucoup pour ton aide.
Cordialement