[發問] checkbox新增及更名

rick4615

小弟現在要做一個新增checkbox新增及同時改名之commonbottom
並且在按的同時 刪除舊有的checkbox 並新增 新的checkbox
以 第三列為listname
不過在第二次按下此bottom時會產生無法盡數刪除情形
會留下第一個checkbox無法更名  造成後面之checkbox名字皆錯
求解!! 感激不盡


CK刪除為刪除現有ckbox
函式如下
Sub CK刪除()
   Dim CK As Object
   For Each CK In ActiveSheet.OLEObjects
    If CK.Name Like "CheckBox*" Then
        CK.Delete
    End If
   Next
   End Sub

以下為程式碼

Private Sub CommandButton1_Click() '資料篩選
    Call CK刪除
   
    Range("A4:K4").Select
    Range("A4:K4", Selection.End(xlDown)).Select
   
    If Selection.Count > 999999 Then '不接受低於二筆資料處理
        MsgBox ("資料表輸入資料太少，請確認。")
        Exit Sub
    End If
   
    '2013/07/31 Test
    Range("A3").Select
    Range("A3", Selection.End(xlToRight)).Select
    ListCount = Selection.Columns.Count
    ComboBox1.Clear
    ReDim listname(ListCount - 1) As String
    For i = 0 To ListCount - 1
        If i <= 25 Then
            listname(i) = Range(Chr(65 + i) & "3").Text
        Else
            listname(i) = Range("A" & Chr(65 + i - 25) & "3").Text
        End If
        ComboBox1.AddItem listname(i)
    Next i
   
   
     '新增checkbox
     
     For i = 0 To ListCount - 1
        OLEObjects.Add(ClassType:="Forms.CheckBox.1", Link:=False, _
        DisplayAsIcon:=False, Left:=0 + 93.5 * i, Top:=126, Width:=90, Height:=22.5).Select
     Next i
   
   
    'checkbox改名
     ReDim listname1(ListCount) As String
     For i = 1 To ListCount
        If i <= 25 Then
            listname1(i) = Range(Chr(64 + i) & "3").Text
        Else
            listname1(i) = Range("A" & Chr(64 + i - 25) & "3").Text
        End If
    Next i
   
     For i = 1 To ListCount
      Sheets("資料").OLEObjects("CheckBox" & i).Object.Caption = listname1(i)
     Next i

rick4615

對了 補充一下 如果我把call ck刪除
獨立一個bottom出來處理  就不會有這個情況
合在一起才出現的

stillfish00

回復 2# rick4615

1. Sub Test()
   
2.   Dim ar, obj, i As Long
   
3.   
   
4.   With Sheets("資料")
   
5.     'Combobox
   
6.     ar = Application.Transpose(Application.Transpose(.Range(.[A3], .[A3].End(xlToRight)).Value))
   
7.     .ComboBox1.List = ar
   
8.    
   
9.     '刪除checkbox
   
10.     For Each obj In .OLEObjects
    
11.       If obj.Name Like "CheckBox*" Then obj.Delete
    
12.     Next
    
13.    
    
14.     '新增checkbox
    
15.     For i = 1 To UBound(ar)
    
16.       With .OLEObjects.Add(ClassType:="Forms.CheckBox.1", Link:=False, _
    
17.         DisplayAsIcon:=False, Left:=0 + 93.5 * (i - 1), Top:=126, Width:=90, Height:=22.5)
    
18.         .Object.Caption = ar(i)   '改名
    
19.       End With
    
20.     Next
    
21.   End With
    
22. End Sub

複製代碼

rick4615

感謝大大的解答!
似乎把改名跟新增這兩個動作一起做的時候就不會出現這種問題??
如果分開寫有解嗎@@?

stillfish00

回復 4# rick4615

　.OLEObjects("CheckBox" & i) 　
    不是一個安全的方法取得ActiveX物件，有時會發生 Run-time error 1004, Unable to get Object Property of OLEObject class

　改用　.OLEObjects(n)   取得（n為數字）比較安全，再另外判斷名字是否含CheckBox。