Contours automatique

Bonjour,

Pourriez vous me dire comment faire pour lorsque je tape un nombre dans une cellule excel dessine, les contours, ou colorie d autres cellules en quantites identiques au chiffre tapé.

Merci par avance

Bonjour

Une manière de faire

Macro à coller dans le code de la feuille : Clic droit sur le nom de l'onglet ---> Visualiser le code

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Count > 1 Then Exit Sub
  If Val(Target) > 0 Then
    With Target.Resize(1, Target)
      .Interior.ColorIndex = 6
      .Borders.Weight = xlThin
   End With
  End If
End Sub

Merci beaucoup pour votre reponse, pourriez vous me dire comment faire pour le contour ne commence que sur la cellule a cote du chiffre et qu'il n'y ai que 10 cellules par ligne affecté par la formule ( donc si chiffre 20, il y aurait 2 lignes avec 10 cellules coloriees ). j'espere ne pas exagerer par mes demandes . merci

Bonjour

A vérifier

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Reste As Integer
Dim J As Integer

  If Target.Count > 1 Then Exit Sub
  If Val(Target) > 0 Then
    Reste = Target
    J = 0
    While Reste > 10
      With Target.Offset(J, 1).Resize(1, 10)
        .Interior.ColorIndex = 6
        .Borders.Weight = xlThin
      End With
      J = J + 1
      Reste = Reste - 10
    Wend
    With Target.Offset(J, 1).Resize(1, Reste)
      .Interior.ColorIndex = 6
      .Borders.Weight = xlThin
    End With
  End If
End Sub

C est parfait,

merci pour votre aide

Pourriez vous m'indiquer comment faire si je retape 0 dans la cellule du chiffre pour que les cellules coloriées redevienne vierge

Pourriez vous aussi me dire comment appliquer cette formule A quelques cellules definies

Bonjour

Plage autorisée E2:E10

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Reste As Integer
Dim J As Integer

  If Not Intersect(Range("E2:E10"), Target) Is Nothing And Target.Count = 1 Then
    While Target.Offset(J, 1).Interior.ColorIndex = 6
      With Target.Offset(J, 1).Resize(1, 10)
        .Interior.ColorIndex = xlNone
        .Borders.LineStyle = xlNone
      End With
      J = J + 1
    Wend
    If Val(Target) > 0 Then
      J = 0
      Reste = Target
      While Reste > 10
        With Target.Offset(J, 1).Resize(1, 10)
          .Interior.ColorIndex = 6
          .Borders.Weight = xlThin
        End With
        J = J + 1
        Reste = Reste - 10
      Wend
      With Target.Offset(J, 1).Resize(1, Reste)
        .Interior.ColorIndex = 6
        .Borders.Weight = xlThin
      End With
    End If
  End If
End Sub

Merci. derniere demande. Comment faire pour que la formule prenne en compte le changement du chiffre ( si 0, plus de cellules coloriées etc..... )

merci

Bonsoir

Mikael57 a écrit :

la formule prenne en compte le changement du chiffre ( si 0, plus de cellules coloriées etc..... )

As-tu essayé ?

Ou alors expliques-moi car en principe si tu tapes 0 cela efface les cellules coloriées

Oui, lorsque je tape 0 rien ne produit!

Bonsoir

Joins un fichier avec le problème

A suivre

bonjour,

j'ai modifie certaine chose ( saut de ligne, decalage colonne etc.....) dont la couleur de remplissage ou j'ai mis 0.

c'est ce dernier point qui a fait que ca ne fonctionnait plus. je ne voulais pas de couleur donc j'ai mis 0, cela a cree "l'erreur".

j'ai mis 2 c'est redevenu OK.

Ton programme a l'origine fonctionne correctement

Merci pour ton aide

Bonjour

Le résultat : Le programme fonctionne ou toujours un problème ?

oui le programme fonctionne

merci