Excel 自定义提示框/批注，悬浮单元格上

1、引用Ms Forms 2.0 object library.

2、复制以下代码至需要使用的工作表代码页里，代码备注见图片

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)   

On Error Resume Next   

Application.EnableEvents = False    

Application.ScreenUpdating = False

Dim ole As OLEObject   

Dim olex As OLEObject   

Dim obj, objz   

Dim nm As Variant   

Dim lbx As Boolean   

Dim oWS As Worksheet   

Set oWS = Target.Parent   

 If oWS.OLEObjects.Count >= 1 Then       

For Each ole In Me.OLEObjects           

If ole.Name = "sysLblz" Then               

Set obj = ole.Object                

nm = obj.Caption               

oWS.OLEObjects(nm).Delete               

lbx = True           

End If       

Next   

End If   

If lbx = False Then 'if not exist sysLblz,generate it for save textbox name       

Set ole = oWS.OLEObjects.Add(ClassType:="Forms.label.1", Link:=False, DisplayAsIcon:=False, Left:=1, Top:=1, Width:=1, Height:=1)       

ole.Name = "sysLblz"       

Set obj = ole.Object       

obj.Caption = "sysLblz"   

End If       

If (Target.Column >= 9 And Target.Column <= 15) And (Target.Row >= 3 _    And Target.Row <= 27) And Target.Cells.Count = 1 Then       

If Len(Cells(Target.Row, Target.Column + 8).Value) > 0 Then                       

Set olex = oWS.OLEObjects.Add(ClassType:="Forms.TextBox.1", Link:=False, DisplayAsIcon:=False) ', Width:=500, Height:=200           

olex.Visible = False           

olex.Name = "systxtL"            'DoEvents           

obj.Caption = olex.Name           

Set objz = olex.Object           

With objz               

.FontSize = 16               

.MultiLine = True               

.WordWrap = True               

.Text = Cells(Target.Row, Target.Column + 8).Value 'ActiveCell.Value               

.ForeColor = vbRed               

 .BackColor = RGB(255, 255, 0)               

 .ScrollBars = 2               

.SpecialEffect = 0           

End With           

With olex                '.Visible = False               

.Shadow = False               

.Width = 500               

.Height = 200               

 .Top = Target.Top + Target.Height               

.Left = Target.Left           

End With       

End If     

End If      'DoEvents   

olex.Visible = True   

Application.ScreenUpdating = True   

Application.EnableEvents = True

End Sub