[發問] 重新設置checkbox的群組

caichen3

如何重新設置checkbox的群組呢？
checkbox的群組為它的所在列，若我刪除第12列(整列)，並希望第12列以下的checkbox會重新改變群組號碼？？
並且如何改變checkbox的底色呢？？

GBKEE

回復 1# caichen3
請新增一般模組
於頂端 輸入

1. Option Explicit
   
2. Public Const OB_Caption1 = "功能性需求"
   
3. Public Const OB_Caption2 = "感官性需求"
   
4. Public Const OB_Caption3 = "隱藏性需求"

複製代碼

UserForm1

1. Private Sub CommandButton1_Click()    '客戶的真正需求輸入
   
2.     Dim OB As OLEObject, k As Integer, xR As Integer
   
3.     If ComboBox1.ListIndex = -1 Then Exit Sub      'ComboBox1 的值不在清單內
   
4.     With ActiveSheet
   
5.         .UsedRange.Offset(11) .Clear                 '第12列以下的儲存格 '清除內容
   
6.         With .[A12:F12].Resize(ComboBox1.Value)     '第12列以下的儲存格 擴充為ComboBox1.Value 的列數範圍
   
7.             .Borders.LineStyle = xlContinuous
   
8.             .Borders.ColorIndex = 1
   
9.         End With
   
10.         For Each OB In ActiveSheet.OLEObjects
    
11.             If OB.progID = "Forms.CheckBox.1" Then
    
12.              If OB.TopLeftCell.Row > 11 Then OB.Delete
    
13.             End If
    
14.         Next
    
15.         For k = 1 To ComboBox1.Value
    
16.             .Cells(11 + k, "C") = k
    
17.             For xR = 0 To 2
    
18.                 With .Cells(11 + k, "d").Offset(, xR)   '從 第11後 開使
    
19.                     Set OB = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CheckBox.1", Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height)
    
20.                     OB.Object.Caption = IIf(xR = 0, OB_Caption1, IIf(xR = 1, OB_Caption2, OB_Caption3))
    
21.                     OB.Object.GroupName = .Row          '以列號為群組名稱
    
22.                     If OB.Object.Caption = OB_Caption3 Then OB.Object.BackColor = &H80FFFF
    
23.                 End With
    
24.             Next
    
25.         Next
    
26.     End With
    
27.     Unload UserForm1
    
28. End Sub

複製代碼

表6-6

1. Private Sub CommandButton2_Click()    '刪除
   
2.     Dim xR As Integer, OB As OLEObject
   
3.     With ActiveSheet
   
4.         If ActiveCell.Row > Cells(Rows.Count, "C").End(xlUp).Row Or ActiveCell.Row <= 11 Then Exit Sub
   
5.         xR = ActiveCell.Row
   
6.         For Each OB In ActiveSheet.OLEObjects
   
7.             If OB.Name Like "CheckBox*" Then
   
8.                 If OB.TopLeftCell.Row = xR Then OB.Delete   'TopLeftCell.Row 控制項所在的位置.列號
   
9.             End If
   
10.         Next
    
11.         .Cells(xR, "A").Resize(, 6).Delete xlUp
    
12.         For Each OB In ActiveSheet.OLEObjects
    
13.             If OB.Name Like "CheckBox*" Then
    
14.                 If OB.TopLeftCell.Row >= xR Then
    
15.                 '>=TopLeftCell.Row 控制項所在的位置.列號  才需重新整理 群組名稱
    
16.                     OB.Object.GroupName = OB.TopLeftCell.Row
    
17.                     .Cells(OB.TopLeftCell.Row, "C") = OB.TopLeftCell.Row - 11
    
18.                     '設置 C欄的數字
    
19.                 End If
    
20.             End If
    
21.         Next
    
22.     End With
    
23. End Sub
    
24. Private Sub CommandButton4_Click()   '新增
    
25.     Dim xR  As Range, xi As Integer
    
26.     With ActiveSheet
    
27.         Set xR = .Cells(Rows.Count, "C").End(xlUp).Offset(1)   'C欄的數字最後有一個資料的儲存格 往下一列
    
28.         If xR.Row <= 11 Then Set xR = .Cells(12, "C")
    
29.         xR = xR.Row - 11            ' 給值 : 從第11 列開始
    
30.         For xi = 1 To 3
    
31.             With xR.Offset(, xi)
    
32.                 Set OB = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CheckBox.1", Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height)
    
33.                 OB.Object.Caption = IIf(xi = 1, OB_Caption1, IIf(xi = 2, OB_Caption2, OB_Caption3))
    
34.                 OB.Object.GroupName = xR.Row   '對應列號
    
35.                 If OB.Object.Caption = OB_Caption3 Then OB.Object.BackColor = &H80FFFF
    
36.             End With
    
37.         Next
    
38.         With .Range(Cells(xR.Row, "A"), .Cells(xR.Row, "F"))
    
39.             .Borders.LineStyle = xlContinuous
    
40.             .Borders(xlEdgeRight).ColorIndex = 1
    
41.         End With
    
42. End With
    
43. End Sub

複製代碼

caichen3

回復 2# GBKEE
感謝大大的大力幫助，受益良多，:)  :D