caichen3

非常感謝各位大大的回覆，以後我的提問會更清楚說明一些
以下是我要呈現的畫片結果
A欄：編號   B欄：使用者需求敘述  C欄：空儲存格   D~H欄：放置OptionButton ，每一列為一個群組，並以編號1~5依序排列(OptionButton以OB表示)
      A      B       C          D               E              F                G              H
1   1     xxx             OB0-1     OB0-2     OB0-3      OB0-4     OB0-5
2   2     yyy             OB1-1     OB1-2     OB1-3      OB1-4     OB1-5
3   3     zzz             OB2-1     OB2-2     OB2-3      OB2-4     OB2-5
4   4      jjj               OB3-1     OB3-2     OB3-3      OB3-4     OB3-5
5   5      iii               OB4-1     OB4-2     OB4-3      OB4-4     OB4-5
6
7

如果我想要插入新的一列，並且希望能在該列上新增OptionButton，像上述以編號1~5呈現，但原先的工作表上已被選取的OptionButton資料不會被清除呢？？

Hsieh

回復 21# caichen3

1. Sub Add_Opt()
   
2. Dim ob As OLEObject, Rng As Range, A As Range, B As Range
   
3. n = 0
   
4. For Each ob In ActiveSheet.OLEObjects
   
5. Set A = ob.TopLeftCell
   
6.     If Rng Is Nothing Then
   
7.       Set Rng = ob.TopLeftCell.EntireRow
   
8.       n = 1
   
9.       ElseIf Intersect(Rng, ob.TopLeftCell) Is Nothing Then
   
10.       Set Rng = Union(Rng, ob.TopLeftCell.EntireRow)
    
11.       n = n + 1
    
12.     End If
    
13. Next
    
14. For Each A In Range("A:A").SpecialCells(xlCellTypeConstants)
    
15. Set B = Nothing
    
16. If Not Rng Is Nothing Then Set B = Intersect(A, Rng)
    
17. If B Is Nothing Then
    
18.    n = n + 1
    
19.    mystr = "OB" & n & "-"
    
20.    For i = 1 To 5
    
21.    cap = mystr & i
    
22.    With A.Offset(, i + 1)
    
23.       Set ob = ActiveSheet.OLEObjects.Add(ClassType:="Forms.OptionButton.1", _
    
24.          Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height)
    
25.          ob.Object.Caption = cap
    
26.          ob.Object.GroupName = "群組 " & n
    
27.    End With
    
28.    Next
    
29. End If
    
30. Next
    
31. End Sub

複製代碼

caichen3

誠心感謝H大大的幫忙，解決我的難題，真的非常感謝你！！

caichen3

拜託H大大可以幫我看看{新增}按鈕程式碼的部份嗎？？
如果我按過{刪除}按鈕，再緊接著按{新增}按鈕，
新增的選項按鈕的群組就會重複！！(n：群組號碼)
一直找不出是哪裡出了問題@@

GBKEE

回復 24# caichen3
試試看

1. Option Explicit
   
2. Private Sub CommandButton4_Click()
   
3.     Dim xR As Integer, Ar(1 To 5), xi As Integer, OB As OLEObject
   
4.     With ActiveSheet
   
5.         .CommandButton4.Placement = xlFreeFloating
   
6.         xR = .Cells(Rows.Count, "A").End(xlUp).Row         'A欄最後有資料的列號
   
7.         Ar(1) = xR & "非常不重要" & "(" & xR & ")"
   
8.         Ar(2) = xR & "不重要" & "(" & xR & ")"
   
9.         Ar(3) = xR & "普通" & "(" & xR & ")"
   
10.         Ar(4) = xR & "重要" & "(" & xR & ")"
    
11.         Ar(5) = xR & "非常重要" & "(" & xR & ")"
    
12.         For xi = 1 To 5
    
13.             With .Cells(xR + 1, "A").Offset(, xi + 2)      '以A欄為主   最後有資料的列號 + 1列的位置
    
14.                 Set OB = ActiveSheet.OLEObjects.Add(ClassType:="Forms.OptionButton.1", Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height)
    
15.                 OB.Object.Caption = Ar(xi)
    
16.                 OB.Object.GroupName = "Row" & xR + 1   '對應列號
    
17.             End With
    
18.          Next
    
19.         With .Range(.Cells(2, "A"), .Cells(xR + 1, "A")).Resize(, 8) 'A2:H & xR + 1
    
20.             .Columns(1) = "=row()-1"                                 'A欄公式 依列號-1
    
21.             .Columns(1) = .Columns(1).Value                           '將公式 轉成 值
    
22.             .Columns(1).Interior.ColorIndex = 15
    
23.             .Borders.LineStyle = xlContinuous
    
24.             .Borders(xlEdgeBottom).Weight = xlThick
    
25.             .Borders(xlEdgeRight).Weight = xlThick
    
26.             .Borders(xlEdgeLeft).Weight = xlThick
    
27.         End With
    
28.     End With
    
29. End Sub
    
30. Private Sub CommandButton5_Click()
    
31.     Dim xR As Integer, OB As OLEObject, Sp As Variant, MyStr As String
    
32.     With ActiveSheet
    
33.         .CommandButton5.Placement = xlFreeFloating
    
34.          If ActiveCell.Row > .Cells(Rows.Count, "A").End(xlUp).Row Then Exit Sub  '不是範圍中
    
35.         xR = ActiveCell.Row                                          '取得 作用儲存格的列號
    
36.         For Each OB In ActiveSheet.OLEObjects
    
37.             If OB.Name Like "OptionButton*" Then
    
38.                 If OB.Object.GroupName = "Row" & xR Then OB.Delete  '刪除作用儲存格的列號 群組
    
39.             End If
    
40.         Next
    
41.         .Cells(xR, "A").Resize(, 8).Delete xlUp                      '刪除作用儲存格 A欄到H欄
    
42.         xR = .Cells(Rows.Count, "A").End(xlUp).Row
    
43.         With .Range(.Cells(2, "A"), .Cells(xR, "A")).Resize(, 8)     'A2:H & xR :範圍中
    
44.             .Columns(1) = "=row()-1"
    
45.             .Columns(1) = .Columns(1).Value
    
46.             .Columns(1).Interior.ColorIndex = 15
    
47.             .Borders.LineStyle = xlContinuous
    
48.             .Borders(xlEdgeBottom).Weight = xlThick
    
49.             .Borders(xlEdgeRight).Weight = xlThick
    
50.             .Borders(xlEdgeLeft).Weight = xlThick
    
51.         End With
    
52.         For Each OB In .OLEObjects                      '重新配置 OptionButton的文字 及 GroupName
    
53.             If OB.Name Like "OptionButton*" Then
    
54.                 Sp = Split(OB.TopLeftCell.Address(), "$")  '拆解 OptionButton 所在絕對位 置例: $D$5
    
55.                 Select Case Sp(1)
    
56.                     Case "D"
    
57.                         MyStr = "非常不重要"
    
58.                     Case "E"
    
59.                         MyStr = "不重要"
    
60.                     Case "F"
    
61.                         MyStr = "普通"
    
62.                     Case "G"
    
63.                         MyStr = "重要"
    
64.                     Case "H"
    
65.                         MyStr = "非常重要"
    
66.                 End Select
    
67.                 OB.Object.Caption = Sp(2) - 1 & MyStr & "(" & Sp(2) - 1 & ")"
    
68.                 OB.Object.GroupName = "Row" & Sp(2)    '對應列號
    
69.             End If
    
70.         Next
    
71.     End With
    
72. End Sub

複製代碼

caichen3

謝謝大大的幫助，還細心的提供說明註解，讓我清楚程式的整體架構，感謝喔