Afficher un cercle si
Bonjour, au pire on regarde si la sélection prend F5 ou R7 :
Dim forme As Shape
Dim cel As Range
If Not Intersect(Target, activesheet.Range("F5"), activesheet.Range("R7")) Is Nothing Then
For Each cel in Target.cells
If cel.value = "a" then
nom = ""
On Error Resume Next 'on passe à la ligne suivante en cas d'erreur
nom = activesheet.Shapes.Range(Array("Forme" & cel.Address)).Name 'on regarde si la forme existe en tentant
'de récupérer son nom, pour éviter de la recréer
On Error GoTo 0
If nom = "" Then
'ajout d'une forme stockée dans forme
Set forme = activesheet.Shapes.AddShape(msoShapeRoundedRectangle, cel.MergeArea.Left + 10, cel.MergeArea.Top + 47, _
cel.MergeArea.Width - 20, cel.MergeArea.Height - 90)
With forme
.Name = "Forme" & cel.Address 'afin de donner un nom unique à chaque forme on y met l'adresse de la cellule traitée
.Adjustments.Item(1) = 0.5
.Fill.Visible = msoFalse
.Line.ForeColor.RGB = RGB(0, 0, 0)
.Line.Weight = 2
End With
Set forme = Nothing 'on vide l'objet forme
End If
ElseIf cel.value <> "a" And Not Intersect(Target, activesheet.Range("F5"), activesheet.Range("R7")) Is Nothing Then 'si on vide la cellule ou qu'elle n'est pas égale à a
On Error Resume Next
activesheet.Shapes.Range(Array("Forme" & cel.Address)).Delete
On Error GoTo 0
End If
Next cel
End IfSauf que cel est dans Target... si Target ne contient pas F5 c'est pareil...
Rien de diff....
Rebonjour, à essayer :
Dim forme As Shape
Dim cel As Range, cellule as Range, Plage as Range
set Plage = Target
Goto debut
if Target.dependents.cells.count > 0 then
for each cellule in target.dependents.cells
Set Plage = cellule
goto debut
next cellule
End If
debut:
If Not Intersect(Plage , activesheet.Range("F5") Is Nothing Then
For Each cel in Plage .cells
If cel.value = "a" then
nom = ""
On Error Resume Next 'on passe à la ligne suivante en cas d'erreur
nom = activesheet.Shapes.Range(Array("Forme" & cel.Address)).Name 'on regarde si la forme existe en tentant
'de récupérer son nom, pour éviter de la recréer
On Error GoTo 0
If nom = "" Then
'ajout d'une forme stockée dans forme
Set forme = activesheet.Shapes.AddShape(msoShapeRoundedRectangle, cel.MergeArea.Left + 10, cel.MergeArea.Top + 47, _
cel.MergeArea.Width - 20, cel.MergeArea.Height - 90)
With forme
.Name = "Forme" & cel.Address 'afin de donner un nom unique à chaque forme on y met l'adresse de la cellule traitée
.Adjustments.Item(1) = 0.5
.Fill.Visible = msoFalse
.Line.ForeColor.RGB = RGB(0, 0, 0)
.Line.Weight = 2
End With
Set forme = Nothing 'on vide l'objet forme
End If
ElseIf cel.value <> "a" And Not Intersect(Plage , activesheet.Range("F5")) Is Nothing Then 'si on vide la cellule ou qu'elle n'est pas égale à a
On Error Resume Next
activesheet.Shapes.Range(Array("Forme" & cel.Address)).Delete
On Error GoTo 0
End If
Next cel
returnLa différence ici c'est qu'on va aussi regarder les dépendants directs de la cellule que l'on va modifier, du coup on va aussi passer par F5 normalement, merci de me confirmer
Il y a une erreur de compilation :
If Not Intersect(Plage , activesheet.Range("F5") Is Nothing Then
For Each cel in Plage .cells
Bonjour,
cette formule fonctionne bien, cependant uniquement si on change directement la valeur de F5 et appuyer ENTER.
Le soucis est que F5 = R7 et le code ne marche pas si on modifie la valeur de R7.
Dim forme As Shape
Dim cel As Range
If Not Intersect(Target, activesheet.Range("F5")) Is Nothing Then
For Each cel in Target.cells
If cel.value = "a" then
nom = ""
On Error Resume Next 'on passe à la ligne suivante en cas d'erreur
nom = activesheet.Shapes.Range(Array("Forme" & cel.Address)).Name 'on regarde si la forme existe en tentant
'de récupérer son nom, pour éviter de la recréer
On Error GoTo 0
If nom = "" Then
'ajout d'une forme stockée dans forme
Set forme = activesheet.Shapes.AddShape(msoShapeRoundedRectangle, cel.MergeArea.Left + 10, cel.MergeArea.Top + 47, _
cel.MergeArea.Width - 20, cel.MergeArea.Height - 90)
With forme
.Name = "Forme" & cel.Address 'afin de donner un nom unique à chaque forme on y met l'adresse de la cellule traitée
.Adjustments.Item(1) = 0.5
.Fill.Visible = msoFalse
.Line.ForeColor.RGB = RGB(0, 0, 0)
.Line.Weight = 2
End With
Set forme = Nothing 'on vide l'objet forme
End If
ElseIf cel.value <> "a" And Not Intersect(cel, Range("F5")) Is Nothing Then 'si on vide la cellule ou qu'elle n'est pas égale à a
On Error Resume Next
activesheet.Shapes.Range(Array("Forme" & cel.Address)).Delete
On Error GoTo 0
End If
Next cel
End IfBonjour
Les modifications de cellules lors du recalcul ne ont pas des changements pour Excel.
On peut intercepter le recalcul pour agir mais cela risque de ralentir le fonctionnement...
Dacc, merci pour votre réponse.
Du coup je crois que ce je cherche à faire n'est pas possible
Bonjour,
C'est pour ça que j'étais passé par la collection cells de dependents mais il faut croire que ça bug encore...
Dur de savoir pourquoi avec seulement les codes...
Bonjour,
>j'aimerai que excel m'affiche un cercle autour d'une cellule (B6, par exemple) seulement si la cellule B6 continent la lettre "a".
Si la cellule B6 est vide alors le cercle disparaît.
cf PJ
Ceuzin