Board logo

標題: [發問] 重新設置checkbox的群組 [打印本頁]
作者: caichen3    時間: 2012-4-26 13:39     標題: 重新設置checkbox的群組

本帖最後由 caichen3 於 2012-4-27 10:20 編輯

如何重新設置checkbox的群組呢？
checkbox的群組為它的所在列，若我刪除第12列(整列)，並希望第12列以下的checkbox會重新改變群組號碼？？
並且如何改變checkbox的底色呢？？
作者: GBKEE    時間: 2012-4-29 11:47

本帖最後由 GBKEE 於 2012-4-29 13:48 編輯

回復 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    時間: 2012-4-30 11:07

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



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)