VBA: changer de police selon critères

Résolu/Fermé

Aline - 19 juil. 2017 à 12:07
ccm81 Messages postés 10851 Date d'inscription lundi 18 octobre 2010 Statut Membre Dernière intervention 16 avril 2024 - 24 juil. 2017 à 11:12

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

A voir également:

VBA: changer de police selon critères
Incompatibilité de type vba ✓ - Forum Programmation
Vba attendre 1 seconde ✓ - Forum VB / VBA
Vba dernière colonne non vide ✓ - Forum VB / VBA
Vba récupérer valeur cellule ✓ - Forum VB / VBA
Mkdir vba ✓ - Forum VB / VBA

2 réponses

Réponse 1 / 2

grégoire
19 juil. 2017 à 12:32

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

Aline
21 juil. 2017 à 08:28

Bonjour Grégoire,

Je n'arrive malheureusement pas à avoir accès à ton lien, peux-tu me faire une capture écran de la macro stp ?

grégoire > Aline
21 juil. 2017 à 09:10

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

Aline
24 juil. 2017 à 08:48

Bonjour Grégoire,

Je viens de réussir à terminer ma macro merci beaucoup pour ton aide.

Cordialement

Réponse 2 / 2

ccm81 Messages postés 10851 Date d'inscription lundi 18 octobre 2010 Statut Membre Dernière intervention 16 avril 2024 2 404
24 juil. 2017 à 11:12

Bonjour à tous les deux

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

Discussions similaires

"L'indice n'appartient à la sélection" + VBA

VBA : Range avec références variables..

VBA erreur 1004

ouverture d'un fichier excel à partir d'un code VBA

Méthode find dans VBA - Recherche de données sous Excel

Discussions similaires

Newsletters