Discussion :

[yvidal]

Bonjour à tous,

Une fois de plus je m'en remets à vous pour améliorer un de mes programmes en VBA sous Excel.

Je dois attirer l'attention de l'utilisateur sur une cellule en particulier. Cette cellule n'est pas toujours la même et n'est pas toujours sur la même feuille. Je souhaiterais donc l'entourer avec un cercle.

Ce que je souhaiterais donc convertir en langage VBA est la manipulation suivante :
Cliquer sur l'onglet insertion => forme => Ellipse => Couleur intérieur de l'ellipse = xlnone => bordure en rouge => Ellipse se place automatiquement sur la cellule active.

C'est essentiellement pour la dernière étape que j'aurais besoin de votre aide.

Merci par avance à tous ceux qui prendront le temps de lire le post.

[Kimy_Ire]

Bonjour yvidal,

J'imagine que tu connais l'enregistreur de macro.
Avec celui-ci et deux recherches web, tu tombes facilement sur ce tuto.

Cela donne, de manière très rapide ce bout de code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub ShapeActivecell()
Dim L As Single, T As Single, H As Single, W As Single
 
'Dimensions et position de la zone de texte
H = ActiveCell.Height '<-- hauteur
W = ActiveCell.Offset(0, 1).Left - ActiveCell.Left  '<-- largeur
L = ActiveCell.Left '<-- position horizontale
T = ActiveCell.Top '<-- position verticale
 
ActiveSheet.Shapes.AddShape(msoShapeOval, L, T, W, H).Select
Selection.ShapeRange.Fill.Visible = msoFalse
With Selection.ShapeRange.Line
    .Visible = msoTrue
    .ForeColor.RGB = RGB(255, 0, 0)
    .Transparency = 0
End With
 
End Sub

Je te laisse adapter.

N'hésite pas à revenir vers moi et le forum en cas de soucis.

Kimy

[Menhir]

Juste une petite variante :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Dim Marge As Double
Marge = 0.5
ActiveSheet.Shapes.AddShape(msoShapeOval, _
       Selection.Left - Selection.Width * Marge, _
       Selection.Top - Selection.Height * Marge, _
       Selection.Width * (1 + 2 * Marge), _
       Selection.Height * (1 + 2 * Marge)).Select

A toi d'ajuster la variable Marge en fonction de la marge que tu veux autour de ta cellule.

[patricktoulon]

re
tiens pour s'amuser un peu
dans le module thisworkbook

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
 
Public WithEvents cmbrs As CommandBars
Public shap As Shape
Public adr As String
Public s As Range
' Roule tambours
' <<<<<<<<< NON BLOQUANT ET SANS DOEVENTS >>>>>>>>>>>
Private Sub cmbrs_OnUpdate()
    Static i As Long
    i = IIf(i = 4, 5, 4)
    With shap.Line: .DashStyle = i: .Weight = 2: .ForeColor.RGB = vbRed: End With
    Application.CommandBars.FindControl(ID:=2040).Enabled = Application.CommandBars.FindControl(ID:=2040).Enabled = False
    ' la simple selection de la cellule en question arrete tout et supprime la shape
    If TypeName(Selection) = "Range" Then
        If Selection.Address(0, 0) = adr Then Set cmbrs = Nothing: shap.Delete
    End If
End Sub
'
'
Sub test()
    Dim Marge As Double
    With ThisWorkbook
    .adr = "B6"
    Set .s = Sheets(1).Range(.adr)    ' mettre le range ou cellule que tu veux ici
    Marge = 0.5
    Set .shap = ActiveSheet.Shapes.AddShape(msoShapeOval, .s.Left - .s.Width * Marge, .s.Top - .s.Height * Marge, .s.Width * (1 + 2 * Marge), .s.Height * (1 + 2 * Marge))
    .shap.Fill.Visible = msoFalse
    Set .cmbrs = Application.CommandBars
End With
End Sub

tu lance la sub test d'où tu veux en fait elle peut se trouver dans un module standard si tu veux ou une feuille



tu crois qu'on va la voir la cellule

[OrDonc]

Bonjour

Sans contexte défini, une approche avec une seule forme ellipse prédéfinie nommée La,
(sans remplissage et une bordure formatée -couleur, style ...) intervenant dans la plage B2 :F13* !

Dans la fenêtre des codes de l’onglet source :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Private Sub Worksheet_SelectionChange(ByVal R As Range)
  With Me.Shapes("La")
      .Visible = 0
      If Not Intersect(R, [B2:F13]) Is Nothing And R.Count = 1 Then
          .Top = R.Top - 5: .Left = R.Left - 5: .Height = R.Height + 10: .Width = R.Width + 10
          .Visible = 1
      End If
  End With
End Sub

*à adapter sachant que pour des cellules cibles en bord haut, bas, gauche, droit, c’est une autre histoire visuelle

[yvidal]

Bonjour,

Merci à tous pour vos contributions aussi rapidement.

J'ai opté pour la première solution de Kimy déjà car c'est la première que j'ai testé et qu'elle correspond exactement à ce que je recherche =) mais aussi car elle est "simple" à comprendre. Visiblement tu cherches mieux que moi car moi j'avais uniquement trouvé comment encadrer ma cellule (en augmentant l'épaisseur de la bordure) mais pas en insérant une forme.

Je l'ai adapté de la façon suivante afin que la cellule soit bien entourée et non que l'ellipse soit contenu dans la cellule :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub ShapeActivecell()
Dim L As Single, T As Single, H As Single, W As Single
 
'Dimensions et position de la zone de texte
H = ActiveCell.Height * 2 '<-- hauteur
W = ActiveCell.Offset(0, 1).Left - ActiveCell.Left / 1.25 '<-- largeur
L = ActiveCell.Left - ActiveCell.Width / 4 '<-- position horizontale
T = ActiveCell.Top - ActiveCell.Height / 2 '<-- position verticale
 
ActiveSheet.Shapes.AddShape(msoShapeOval, L, T, W, H).Select
Selection.ShapeRange.Fill.Visible = msoFalse
With Selection.ShapeRange.Line
    .Visible = msoTrue
    .ForeColor.RGB = RGB(255, 0, 0)
    .Weight = 2.25
    .Transparency = 0
End With
 
End Sub

Patrick ton code m'a l'air de bien faire ressortir la cellule peut-être un peu trop même ^^.

Il ne me reste plus qu'à trouver comment nommer l'ellipse afin de pouvoir la supprimer, déplacer, ... dans la suite du programme.

Merci encore pour votre réactivité.

Cordialement,

y_vidal