[50期]在VBA中使用循环批量修改工作表中复选框属性。

zldccmx

一、问题提出
对于在窗体中使用的控件，我们可以通过窗体的Controls方法,利用一个循环来改变窗体中的控件属性
    For I = 1 To 30
        UserForm1.Controls("CheckBox1" & I).Value = True
    Next
更多的属性修改方法，也可以通过循环来完成
    For I = 1 To 30
        With UserForm1.Controls("CheckBox1" & I)
            .Caption = "*****"
            .Top = 20 + Rnd() * 20
            .Value = 1
            .Left = 20 * Rnd()
        End With
    Next
但是，对于工作表，由于没有提供Controls，当我们需要集中修改工作表控件属性时
只能逐个进行修改?例如:
Sheet1.CheckBox1.Value = True
Sheet1.CheckBox2.Value = True
......
Sheet1.CheckBox29.Value = True
Sheet1.CheckBox30.Value = True
如果还要修改其它属性，那代码就显示特别长，看着就不舒服。
特别是当这些控件处于组合状态时，更是不方便批量修改。
二、问题解决方案
难道就没有更好的办法吗？
想一想，如何在工作表中也能用循环来实现批量修改控件的属性？

（备注：通过字符串变量，获取对工作表中控件的访问）

三、题目要求:
1、对工作表中的16个复选框进行排列，前8个是单独的复选框，后8个复选框处于组合状态。（不得在设计模式下更改各控件属性）
2、必须使用循环方式，将这16个复选框排列整齐，前面8个为一列，最上面一个复选框与C6单元格对齐(顶边距、左边距)，其它紧跟在后面， _
    无间隙，与第一个对齐。后面8个为一列，已经组合为一体，要求其与F6单元格对齐(左边距，顶边距)。
3 、根据其名称修改对应的Caption
4、依次设定其链接的单元格为IV列对应行据单元格。如 CheckBox2对应Cells(2,"IV") , CheckBox16 对应Cells(16,"IV")
5、重复运行所编写宏，达到逻辑开关功能，如执行宏之前某复选框为真(假)，则运行宏之后该复选框须为假(真)，反之亦然。
6、完成之后，必须与效果图一致！各复选框字体颜色交替为红、蓝、青排列。
7、使用VBA完成，而且必须使用循环，批量完成。

四：限制条件:
参赛对象：  原则上只允许技术分＜=3分者参与。
                                同时也欢迎广大会员参与，对于对其他参赛优秀作品，不排除加分的可能。
题目分值： 1分，完成要求得1 分，如答题者同时提交三种或以上方法者，可得2分。

特别说明：1、本次竞赛，特别设置了门槛，原则上只对技术分<=3(小于或等于3分)的会员参加，并降低了竞赛题目难度，旨在吸引更多的会员参与。
                  2、直接跟帖回答。
3、答题截止时间 2009-8-20  23:59:59   以发贴最后编辑时间为准



[ 本帖最后由 ldy 于 2009-7-28 10:02 编辑 ]

[ 本帖最后由 清风_ll 于 2009-8-21 22:24 编辑 ]

amulee

不知道这个算不算多种方法。

gg19782002

感觉自己用的方法很平淡。希望能学到更多的知识。
请楼主悉心斧正！

[ 本帖最后由 gg19782002 于 2009-8-6 19:57 编辑 ]

泓()

支持老朽!
简述答题随想:
在想做与不想做之间(因题目限制技术分 我的技术分不在范围)
其实我(或大家)很明白 论坛上技术分为0的高手如云
我也很理解老朽出题之意
其实这题说简单并不简单
我很吃力地写了这段代码 若符合题意 则我必向老朽要技术分

好123

1. Sub VBA_4()
   
2. Dim obj As Object, shp As Shape
   
3. Dim s(1 To 8) As Variant, b As String, h As Long, i As Long
   
4. Application.ScreenUpdating = False
   
5. On Error Resume Next
   
6. With ActiveSheet
   
7.     For Each shp In .Shapes
   
8.         If shp.Name Like "Group*" Then
   
9.             shp.Left = [f6].Left
   
10.             shp.Top = [f6].Top
    
11.             .Shapes(shp.Name).Ungroup
    
12.         End If
    
13.     Next
    
14.     b = "CheckBox"
    
15.     h = .OLEObjects(b & 1).Height
    
16.     For i = 1 To 16
    
17.         Cells(i, "IV") = Not (Cells(i, "IV"))
    
18.         With .OLEObjects(b & i)
    
19.             .Object.Caption = b & i
    
20.             .LinkedCell = "IV" & i
    
21.             If i < 9 Then
    
22.                 .Left = [c6].Left
    
23.                 .Top = [c6].Top + (i - 1) * h
    
24.             Else
    
25.                 s(i - 8) = b & i
    
26.             End If
    
27.             If i Mod 3 = 1 Then
    
28.                 .Object.ForeColor = RGB(255, 0, 0)
    
29.             ElseIf i Mod 3 = 2 Then
    
30.                 .Object.ForeColor = RGB(0, 0, 255)
    
31.             Else
    
32.                 .Object.ForeColor = RGB(0, 255, 255)
    
33.             End If
    
34.         End With
    
35.     Next
    
36.     .Shapes.Range(s).Group
    
37. End With
    
38. Application.ScreenUpdating = True
    
39. End Sub
    

复制代码

mobuli

第一次参加答题，感谢老朽兄提供的试题，下面是我的答题，请审核

[ 本帖最后由 mobuli 于 2009-8-11 09:14 编辑 ]

yes2boy

观摩观摩学习学习

[ 本帖最后由 yes2boy 于 2009-8-17 11:31 编辑 ]

蓝桥玄霜

请老朽老师批阅。

[ 本帖最后由 蓝桥玄霜 于 2009-8-12 21:56 编辑 ]

unsamesky

试试看，第4问看不太懂，不知道做出来的效果是否满足题意！！

[ 本帖最后由 unsamesky 于 2009-8-14 13:34 编辑 ]

zjdh

看看我的可以了吗？

[ 本帖最后由 zjdh 于 2009-8-15 15:12 编辑 ]