Forcer une plage de cellules à rester en corps 7

Bonjour Forum !

Pour des raisons qu’il n’est pas utile de détailler, j’aimerais qu’une plage de cellules reste toujours en corps 7 (voir fichier joint).

Celle plage (que j'ai nommée « plage_en_corps_7) se situe colonne H, de la ligne 19 à la ligne qui précède la cellule où figure la mention « LIGNE INDISPENSABLE AU SYSTÈME : NE PAS SUPPRIMER !!! » (cette ligne est habituellement masquée).

Je suppose que ça peut se faire en VBA, mais je ne sais pas le faire.

Quelqu’un peut-il m’aider ?

Merci !!!

Bonjour

Je ne saisis pas tout

Si elle est masquée : Pourquoi dans format de cellule ne pas mettre la taille des caractères en 7 ?

Sinon avec une procédure évènementielle cela se fait

Bonne journée

Bonjour

Avec un code de feuille qui remet à 7 après sélection de n'importe quelle cellule.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim cell As Range
For Each cell In Range("H19:H26")
cell.Font.Size = 7
Next
End Sub

Cordialement

Merci pour ta réponse.

J'aurais dû préciser que le nombre de lignes de la plage de cellules a vocation à augmenter ou diminuer (d'où l'usage d'une plage de cellules nommées – à moins qu'il y ait un autre moyen de faire...).

Autre pb : il y a déjà du code avec :

Private Sub Worksheet_Change(ByVal Target As Range)

...et je crois qu'on ne peut pas en rajouter facilement

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address = Range("ad16").Address Then
    Recherche (Target.Text)
    Exit Sub
  End If

Dim Pos1 As Integer
Dim Pos2 As Integer

  If Target.Address = Range("C6").Address Then
    Recherche (Target.Text)
  ElseIf Not Intersect(Range("h9:h" & Range("h65536").End(xlUp).Row), Target) Is Nothing Then
    With Cells(Target.Row, 8)
      Pos1 = 0
      Pos2 = 0
      Do
        Pos1 = InStr(Pos1 + 1, .Text, "–")
        If Pos1 > 0 Then
          Pos2 = InStr(Pos1, .Text, ":")
          If Pos2 > 0 Then
            .Characters(Start:=Pos1 + 2, Length:=Pos2 - (Pos1 + 1)).Font.Underline = xlUnderlineStyleSingle
          End If
        End If
      Loop Until Pos1 = 0
    End With
  End If
End Sub

Je ne saurais pas faire tout seul la fusion des 2 codes...

Bonjour

Si j'ai compris

A tester

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Pos1 As Integer
Dim Pos2 As Integer

  If Not Intersect(Range("AD16,C6"), Target) Is Nothing Then
    Recherche (Target.Text)
  ElseIf Not Intersect(Range("H9:H" & Range("H65536").End(xlUp).Row), Target) Is Nothing Then
    With Target
      .Font.Size = 7
      Do
        Pos1 = InStr(Pos1 + 1, .Text, "–")
        If Pos1 > 0 Then
          Pos2 = InStr(Pos1, .Text, ":")
          If Pos2 > 0 Then
            .Characters(Start:=Pos1 + 2, Length:=Pos2 - (Pos1 + 1)).Font.Underline = xlUnderlineStyleSingle
          End If
        End If
      Loop Until Pos1 = 0
    End With
  End If
End Sub
 

Bonne soirée

Tu as compris, et ça marche impec !!!

Merci beaucoup !