两个目的没有达到，求大神帮忙

jhhkh

求助.rar (71.69 KB, 下载次数: 18)

2024-10-4 23:02 上传

点击文件名下载附件

我通过VBA生成多个复选框，我想达到以下两个效果
1。勾选除最下面任何一个复选框，右侧的单元格背景变浅绿色

2.  勾选最下面一个复选框，这一列上面的复选框都被勾选，右侧的一列有数据的所有单元格背景变浅绿色


不知道什么原因，上传压缩文件再次下载，提示文件损坏，所以只好压缩两次，才没有问题，用两次压缩里面的Excel

taller

1. 
   
2. 
   
3. Sub InsertCheckboxesAndHideText()
   
4.     Dim ws As Worksheet
   
5.     Dim col As Long
   
6.     Dim row As Long
   
7.     Dim cb As Object
   
8.     Dim colArray As Variant
   
9.     Dim i As Long
   
10.     Dim FC As FormatCondition, sCell As String, eCell As String
    
11.     ' 设置要操作的工作表
    
12.     Set ws = ThisWorkbook.Sheets("初始赋值")
    
13.    
    
14.     ' 指定需要插入复选框的列：A, C, E, G, ..., Q（隔列）
    
15.     colArray = Array(1, 3, 5, 7, 9, 11, 13, 15, 17) ' 这些是列号
    
16.     Application.ScreenUpdating = False
    
17.     ' 遍历指定列并在第2行到第16行中插入复选框
    
18.     For i = LBound(colArray) To UBound(colArray)
    
19.         col = colArray(i)
    
20.         
    
21.         ' 在每列的2到16行中插入复选框
    
22.         With ws.Cells(row, col)
    
23.         For row = 2 To 17
    
24.             ' 插入复选框
    
25.             Set cb = ws.CheckBoxes.Add(.Left, .Top, .Width, .Height)
    
26.             cb.Caption = "" ' 去掉复选框的标题
    
27.             cb.linkedCell = .Address ' 将复选框与所在单元格链接
    
28.             cb.Display3DShading = True ' 设置复选框为三维阴影效果
    
29.             
    
30.             ' 设置单元格字体颜色为与背景相同，使TRUE或FALSE不可见
    
31.             .Font.Color = .Interior.Color ' 字体颜色设置为与背景颜色相同
    
32.         Next row
    
33.         End With
    
34.         ' ** 设置条件格式
    
35.         With ws.Cells(2, col + 1).Resize(15, 1)
    
36.             sCell = .Cells(1).Offset(0, -1).Address(0, 1)
    
37.             eCell = .Cells(.Cells.Count).Offset(1, -1).Address(1, 0)
    
38.             Set FC = .FormatConditions.Add(Type:=xlExpression, Formula1:="=OR(" & sCell & "," & eCell & ")")
    
39.             FC.Interior.Color = vbGreen
    
40.         End With
    
41.     Next i
    
42.     Application.ScreenUpdating = True
    
43. End Sub
    
44. 
    
45. Sub RemoveFC()
    
46.     Dim FC
    
47.     For Each FC In ActiveSheet.Cells.FormatConditions
    
48.         FC.Delete
    
49.     Next
    
50. End Sub
    
51. 
    
52. Sub 删除所有复选框() ' 简化代码
    
53.     Dim ws As Worksheet
    
54.     Dim cb As CheckBox
    
55.    
    
56.     ' 设置要操作的工作表
    
57.     Set ws = ThisWorkbook.Sheets("初始赋值")
    
58.     ws.DrawingObjects.Delete
    
59.     ' 遍历并删除工作表中的所有复选框
    
60. '    For Each cb In ws.CheckBoxes
    
61. '        cb.Delete
    
62. '    Next cb
    
63. End Sub
    

复制代码

taller