VBA: changer de police selon critères

Résolu
Aline -  
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

2 réponses

  1. grégoire
     
    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
     
    0
    1. Aline
       
      Bonjour Grégoire,

      Je n'arrive malheureusement pas à avoir accès à ton lien, peux-tu me faire une capture écran de la macro stp ?
      0
      1. grégoire > Aline
         
         
        Bonjour Aline,

        Sur la feuille de calcul :

        A B
        1A 10
        2B 14
        3C 18
        4D 22
        5E 28
        6F 14
        7G 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
         
        0
    2. Aline
       
      Bonjour Grégoire,

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

      Cordialement
      0
  2. ccm81 Messages postés 11033 Statut Membre 2 434
     
    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
    -1