|
|
楼主 |
发表于 2019-8-11 11:37
|
显示全部楼层
本帖最后由 YZC51 于 2019-8-12 12:47 编辑
已经修改！还请老师指教！谢谢！
Private Sub ToggleButton1_Click()
Dim JGD As Shape
If Me.ToggleButton1.Caption = "聚光灯-已关" Then
ToggleButton1.Caption = "聚光灯-已开"
Else
ToggleButton1.Caption = "聚光灯-已关"
For Each JGD In ActiveSheet.Shapes
If JGD.Name = "聚光灯-已开" Then JGD.Delete '删除特定名称的图形
Next
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim JGD As Shape, lc!, hh!, Col
If Sheet1.ToggleButton1.Caption = "聚光灯-已开" Then
n = Target.Row: Col = Target.Column: lc = Target.Width: hg = Target.Height
nn = Application.Max(n - 100, 1)
hs = Application.Max(Col - 100, 1)
On Error Resume Next
ActiveSheet.Shapes("聚光灯-已开").Delete
ActiveSheet.Shapes("聚光灯-已开").Delete
' For Each JGD In ActiveSheet.Shapes
' If JGD.Name = "聚光灯-已开" Then JGD.Delete '删除特定名称的图形
'Next
With ActiveSheet.Shapes.AddShape(msoShapeRectangle, Cells(nn, Col).Left, Cells(nn, Col).Top, 10, hg * 200)
.Line.Visible = msoFalse '设置为无轮廓
.Fill.Visible = msoTrue '设置填充（fill）颜色，如果=msofalse，则为无颜色填充
.Fill.ForeColor.RGB = RGB(247, 17, 238) '设置颜色
.Fill.Transparency = 0.6 '设置透明度，数字愈大透明度越高
.Name = "聚光灯-已开"
End With
With ActiveSheet.Shapes.AddShape(msoShapeRectangle, Cells(n, hs).Left, Cells(n, 1).Top, lc * 200, 10) 'hh)
.Line.Visible = msoFalse '设置为无轮廓
.Fill.Visible = msoTrue '设置填充（fill）颜色，如果=msofalse，则为无颜色填充
.Fill.ForeColor.RGB = RGB(247, 17, 238) '设置颜色
.Fill.Transparency = 0.6 '设置透明度，数字愈大透明度越高
.Name = "聚光灯-已开"
End With
End If
End Sub
|
评分
-
2
查看全部评分
-
|
楼主: YZC51
[复制链接]
/1 
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2019-8-2 17:14
