另类的双击事件，划边框，谢谢过客fppt和山菊花和cidanji老师！

lhj323323

老师：

我想实现这样的划边框


求助.rar (8.47 KB, 下载次数: 68)

2023-12-13 15:30 上传

点击文件名下载附件

老师如有空，请帮忙看看，先谢谢了！

lhj323323

一楼有更新，请刷新一下
我把图片里的文字说明完善了

过客fppt

第一次用递归，不足的地方请多多包涵，还有个凸起没有解决

过客fppt

终于解决了

山菊花

右键点击工作表标签，将下面的代码粘贴到VBE窗口光标处，然后返回工作表。

1. Dim hbk As Boolean
   
2. Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
   
3.     Dim Rng As Range
   
4.     Cancel = True
   
5.     If Target.Row = 1 Or Target.Column = 1 Then Exit Sub
   
6.     If Not hbk Then
   
7.         hbk = True
   
8.         UsedRange.Borders.LineStyle = 0
   
9.     End If
   
10.     If Target.Value = "" Then
    
11.         Set Rng = Target.End(2)
    
12.         If Rng.Value = "" Then
    
13.             hbk = False
    
14.             Set Rng = Target.Offset(0, 1)
    
15.         Else
    
16.             Worksheet_BeforeDoubleClick Rng, True
    
17.         End If
    
18.         With Range(Target.Offset(-1), Rng.Offset(-1, -1)).Borders(9)
    
19.             .LineStyle = 1
    
20.             .Color = 255
    
21.             .Weight = 3
    
22.         End With
    
23.     Else
    
24.         With Target.Borders(7)
    
25.             .LineStyle = 1
    
26.             .Color = 255
    
27.             .Weight = 3
    
28.         End With
    
29.         Worksheet_BeforeDoubleClick Target.Offset(1), True
    
30.     End If
    
31. End Sub

复制代码

lhj323323

过客fppt 发表于 2023-12-13 16:20
第一次用递归，不足的地方请多多包涵，还有个凸起没有解决

谢谢老师回复

能否把蓝圈内的红边框删掉？

lhj323323

过客fppt 发表于 2023-12-13 16:29
终于解决了

我发慢了，呵呵，不好意思

lhj323323

山菊花 发表于 2023-12-13 16:30
右键点击工作表标签，将下面的代码粘贴到VBE窗口光标处，然后返回工作表。

谢谢山菊花老师！
太强大！！

lhj323323

过客fppt 发表于 2023-12-13 16:29
终于解决了

谢谢老师！测试成功了

这个问题，从昨天就搞到现在，眼都花了。
终于解决了。

lhj323323

过客fppt 发表于 2023-12-13 16:20
第一次用递归，不足的地方请多多包涵，还有个凸起没有解决

老师太客气了
我哪有资格包涵与否。
感谢还来不及。