1、引用Ms Forms 2.0 object library.
2、复制以下代码至需要使用的工作表代码页里,代码备注见图片Option ExplicitPrivate Sub Worksheet_SelectionChange(ByVal Target As Range)On Error Resume NextApplication.EnableEvents = FalseApplication.ScreenUpdating = FalseDim ole As OLEObjectDim olex As OLEObjectDim obj, objzDim nm As VariantDim lbx As BooleanDim oWS As WorksheetSet oWS = Target.ParentIf oWS.OLEObjects.Count >= 1 ThenFor Each ole In Me.OLEObjectsIf ole.Name = "sysLblz" ThenSet obj = ole.Objectnm = obj.CaptionoWS.OLEObjects(nm).Deletelbx = TrueEnd IfNextEnd IfIf lbx = False Then 'if not exist sysLblz,generate it for save textbox nameSet 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.Objectobj.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 ThenIf Len(Cells(Target.Row, Target.Column + 8).Value) > 0 ThenSet olex = oWS.OLEObjects.Add(ClassType:="Forms.TextBox.1", Link:=False, DisplayAsIcon:=False) ', Width:=500, Height:=200olex.Visible = Falseolex.Name = "systxtL" 'DoEventsobj.Caption = olex.NameSet objz = olex.ObjectWith 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 = 0End WithWith olex '.Visible = False.Shadow = False.Width = 500.Height = 200.Top = Target.Top + Target.Height.Left = Target.LeftEnd WithEnd IfEnd If 'DoEventsolex.Visible = TrueApplication.ScreenUpdating = TrueApplication.EnableEvents = TrueEnd Sub