Bonjour gloub,
voici une autre proposition avec un shape (rectangle) qui s'affiche lorsqu'une cellule de la colonne des numéros de tél est sélectionnée. dans cette exemple j'ai supposé que cette colonne est "B"
le shape devient invisible lorsqu'une cellule d'une autre colonne est sélectionnée ou que la cellule est vide.
page code ThisWorkbook
Private Sub Workbook_BeforeClose(Cancel As Boolean)
effaceShape
End Sub
Private Sub Workbook_Open()
AjoutShape
Range("B1").Select
End Sub
page code de l'onglet des numéros de tél
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Set isect = Application.Intersect(Target, Range("B:B"))
If Target.Count > 1 Then Exit Sub
With ActiveSheet.Shapes("Rectangle 1")
If Not isect Is Nothing And Target.Value <> "" Then
.Visible = True
.Left = Target.Left + Target.Width
.Top = Target.Top - Target.Height
.TextFrame.Characters.Text = Target
Else
.Visible = False
End If
End With
End Sub
Module1
Public obj
Sub effaceShape()
On Error Resume Next
ActiveSheet.Shapes("Rectangle 1").Delete
End Sub
Sub AjoutShape()
Dim Nom As String
Dim obj As Object
l = 0.75
t = 0.75
w = 180
h = 30
With ActiveSheet
Set obj = .Shapes.AddShape(msoShapeRectangle, l, t, w, h)
With obj
.Name = "Rectangle 1"
' .OnAction = "test"
' .Placement = xlFreeFloating
.Fill.Solid
.Fill.Transparency = 0#
.Fill.ForeColor.RGB = RGB(222, 222, 222) ' couleur de fond
.Line.BackColor.RGB = RGB(0, 0, 0) ' couleur de contour
.Line.DashStyle = msoLineSolid
.Line.Style = msoLineSingle
.Line.Visible = msoTrue
.Line.Weight = 1
With .TextFrame.Characters
.Text = "1-000-000-0000"
.Font.Name = "Arial"
.Font.Size = 22
.Font.Bold = False
.Font.Shadow = True
.Font.ColorIndex = xlAutomatic ' couleur de texte
End With
End With
End With
End Sub