Loupe en VBA

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
If Target.Count = 1 And ActiveSheet.Shapes("monshape").Visible = True Then
If Err <> 0 Then creeShape
ActiveSheet.Shapes("monshape").Left = ActiveCell.Left
ActiveSheet.Shapes("monshape").Top = ActiveCell.Top + ActiveCell.Height + 3
ActiveSheet.Shapes("monshape").TextFrame.Characters.Text = ActiveCell
End If
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
ActiveSheet.Shapes("monshape").Visible = Not ActiveSheet.Shapes("monshape").Visible
If ActiveSheet.Shapes("monshape").Visible Then
ActiveSheet.Shapes("monshape").Left = ActiveCell.Left
ActiveSheet.Shapes("monshape").Top = ActiveCell.Top + ActiveCell.Height + 3
ActiveSheet.Shapes("monshape").TextFrame.Characters.Text = ActiveCell
End If
Cancel = True
End Sub
Sub creeShape()
ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 1, 1, 280, 150).Select
Selection.Font.Name = "Verdana"
Selection.Font.Size = 13
Selection.Name = "monshape"
ActiveSheet.Shapes("monshape").Left = ActiveCell.Left
ActiveSheet.Shapes("monshape").Top = ActiveCell.Top + ActiveCell.Height + 3
End Sub

Cliquez pour agrandir...