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

 时间:2024-10-12 00:39:26

1、引用Ms Forms 2.0 object library.

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

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

Excel 自定义提示框/批注,悬浮单元格上
  • excel表格中,把表格设置成阅读模式
  • excel如何利用下拉框自动匹配颜色
  • 在Excel中怎么批量添加批注
  • excel中使用vba来查看可见单元格计数
  • excel中使用vba新建工作表
  • 热门搜索
    小学生手抄报图片大全 预防溺水手抄报 关于春天的手抄报 三年级数学手抄报 爱国手抄报简单又漂亮 汉字的手抄报 消防手抄报简单又漂亮 校园安全手抄报内容 读书手抄报图片 植树节手抄报内容大全