Macro de mise en forme en fonction d'une cellule active

[thombzh]

Bonjour,

Je cherche à réaliser une macro me facilitant la vision de ce que je fais
J'ai mis un fichier en pièce jointe qui sera sûrement plus explicite.

J'ai une colonne B:B (Clients) et une zone de remplissage de E4:AI45
Je voudrais une bordure plus épaisse et rouge dans la cellule de la colonne B:B en fonction de la cellule active dans ma zone de remplissage.

Exemple : si ma cellule active est M14 alors B14 aurait une bordure rouge
si ma cellule active est Z25 alors B25 aurait une bordure rouge

Merci à ceux qui s'attarderont sur mon problème

 

[JHA]

Re : Macro de mise en forme en fonction d'une cellule active

Bonjour à tous,

Ci joint un exemple adapté à ton fichier

Cette macro a été créée par Gaëtan Mourmant

JHA

 

[DoubleZero]

Re : Macro de mise en forme en fonction d'une cellule active

Bonjour, thombzh, JHA, le Forum,

Une suggestion en pièce jointe.

A bientôt

 

[thombzh]

Re : Macro de mise en forme en fonction d'une cellule active

Bonjour,

Merci à vous 2 d'avoir pris le temps de répondre

La macro proposé par JHA est fonctionnelle et vraiment superbe, petite question tout de même, quand on désactive la macro, les lignes et colonnes rouge reste à l'écran, comment remédier à ça ?

DoubleZero, impossible d'exécuter la macro, erreur 1004

Range("a3").CurrentRegion.Borders.Value = 1

Une idée ?

 

[JHA]

Re : Macro de mise en forme en fonction d'une cellule active

Re,

Si tu ne veux pas voir les lignes, mets toi en "A1" et desactive

JHA

 

[thombzh]

Re : Macro de mise en forme en fonction d'une cellule active

Effectivement ça fonctionne comme ça

Concernant l'activation/désactivation de la macro, peut il y avoir une autre solution ?
Si je l'utilise pour un autre fichier, il bloque les autres macro...

Peut être par un bouton à bascule ?
pour que cette macro n'intervienne que sur la feuille active

 

[DoubleZero]

Re : Macro de mise en forme en fonction d'une cellule active

Re-bonjour,

...DoubleZero, impossible d'exécuter la macro, erreur 1004

Range("a3").CurrentRegion.Borders.Value = 1

Une idée ?

Je n'en comprends pas la raison car je n'ai aucun message d'erreur sur mon poste.

A tester : remplacer cette ligne :

Range("a3").CurrentRegion.Borders.Value = 1

par celle-ci :

Range("a3").CurrentRegion.Borders.Value = xlContinuous

A bientôt

 

[thombzh]

Re : Macro de mise en forme en fonction d'une cellule active

Merci DoubleZero, mais même en fisant cette modification, j'ai toujours l'erreur 1004

Pourtant je n'ai rien d'autre de lancer donc aucune interférence possible.
Dès que je clique sur une cellule j'ai cette erreur qui apparait

 

[thombzh]

Re : Macro de mise en forme en fonction d'une cellule active

J'ai tenté de de modifier comme ceci avec un togglebouton mais, comme je m'y attendais, ça ne fonctionne pas...

Private Sub ToggleButton1_Click()
With ToggleButton1
If .Value = True Then
h = ActiveCell.Height
 
'Largeur de la cellule active
w2 = ActiveCell.Width
 
'Hauteur entre la cellule active et la première ligne
t = ActiveCell.Top
 
'Largeur entre la cellule active et la première colonne
w = ActiveCell.Left
 
'Teste si les rectangles existent déjà. Dans ce cas, on les efface.
'On utilise ici On Error Resume Next, qui permet de tester
' l'erreur de création d'un rectangle en double portant le même nom.
On Error Resume Next
ActiveSheet.Shapes("RectangleV").Delete
On Error Resume Next
ActiveSheet.Shapes("RectangleH").Delete
 

' Ajoute les rectangles en fonction des coordonnées précédemment calculées.
' Les rectangles sont transparents, de grosseur 3 et de couleur rouge (10)
' On ne peut pas les imprimer.
ActiveSheet.Shapes.AddShape(msoShapeRectangle, 0, t, w, h).Name = "RectangleV"
With ActiveSheet.Shapes("RectangleV")
    .Fill.Visible = msoFalse
    .Fill.Transparency = 3#
    .Line.Weight = 3#
    .Line.ForeColor.SchemeColor = 10
    .PrintObject = False
End With
 
ActiveSheet.Shapes.AddShape(msoShapeRectangle, w, 0, w2, t).Name = "RectangleH"
 
With ActiveSheet.Shapes("RectangleH")
    .Fill.Visible = msoFalse
    .Fill.Transparency = 3#
    .Line.Weight = 3#
    .Line.ForeColor.SchemeColor = 10
    .PrintObject = False
End With
ElseIf .Value = False Then
Exit Sub
End If
End With
End Sub

Une idée ?

 

[DoubleZero]

Re : Macro de mise en forme en fonction d'une cellule active

Re-bonjour,

...j'ai toujours l'erreur 1004...

Je donne ma langue au chat ... mais tente un nouvel essai !

Reste à savoir si l'erreur se produit sur d'autres postes.

A bientôt

 

[thombzh]

Re : Macro de mise en forme en fonction d'une cellule active

Je me suis lancé à acheter les 225 trucs et astuce de Gaêtan Mourmant qui fournit repère.
En utilsant la macro complémentaire j'ai réussis du coup a faire fonctionner la macro sans qu'elle gêne les autres.

La macro est du type

Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
...
End Sub()

Comment l'activer ou la désactiver à l'aide d'un bouton à bascule ?

 

[BOISGONTIER]

Re : Macro de mise en forme en fonction d'une cellule active

Bonjour,

Avec MFC


http://boisgontierjacques.free.fr/fichiers/jb-Curseur.xls


JB

 

[thombzh]

Re : Macro de mise en forme en fonction d'une cellule active

Merci Boisgontier,

Je n'avais pas envisager cette possibilité du fait que j'ai atteint le nombre max de MFC utilisable pour différencier certains type de client. Ceci dit, je vais utiliser cette solution dans un autre de mes fichiers, se sera moins lourd

Autrement j'ai trouvé le problème dans mon fichier en partant de la solution de JHA, la variable choix était déjà utilisée... J'avais zappé ce point là, comme quoi des pauses s'imposent par moment...

j'ai mis le code comme ceci et ça fonctionne, donc je suis assez satisfait pour le coup

Private Sub ToggleButton1_Click()
 If ToggleButton1.Value Then
 ToggleButton1.Caption = "Désactiver l'aide à la saisie"
            Choix2 = Not Choix2
         Else
ToggleButton1.Caption = "Activer l'aide à la saisie"
On Error Resume Next
ActiveSheet.Shapes("RectangleV2").Delete
On Error Resume Next
ActiveSheet.Shapes("RectangleH2").Delete
On Error Resume Next
ActiveSheet.Shapes("RectangleVB2").Delete
On Error Resume Next
ActiveSheet.Shapes("RectangleHD2").Delete
            Choix2 = Not Choix2
       End If
End Sub