- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
18#
發表於 2013-9-8 13:56
| 只看該作者
回復 18# sworder12
最後跳出小視窗顯示一個「 0 」 請附檔看看
解決造成兩個核取方塊重疊.的程式碼- Option Explicit
- Sub Ex()
- Dim C As Variant, B As Object, I As Integer, Rng(1 To 2) As Range
- With ActiveSheet
- Set Rng(1) = .Range("A:A").SpecialCells(2) '處裡 A欗有資料的文字的 CheckBoxe
- If .CheckBoxes.Count > 1 Then
- For Each C In .CheckBoxes
- If Not Intersect(C.TopLeftCell.Offset(, -1), Rng(1).EntireColumn) Is Nothing Then
- If C.TopLeftCell.Offset(, -1) = "" Then
- C.TopLeftCell.Offset(, 1) = ""
- C.Delete
- Else
- C.Characters.Text = C.TopLeftCell.Offset(, -1)
- If Rng(2) Is Nothing Then
- Set Rng(2) = C.TopLeftCell.Offset(, -1)
- Else
- Set Rng(2) = Union(Rng(2), C.TopLeftCell.Offset(, -1)) '.Offset(, -1)
- End If
- End If
- End If
- Next
- End If
- For Each C In Rng(1) 'Rng(2): CheckBoxe 的TopLeftCell儲存格
- If Rng(2) Is Nothing Then
- Set B = .CheckBoxes.Add(C(1, 2).Left, C.Top, C.Width, C.Height)
- B.Characters.Text = C
- B.LinkedCell = C.Offset(, 2).Address
- ElseIf Intersect(C, Rng(2)) Is Nothing Then
- Set B = .CheckBoxes.Add(C(1, 2).Left, C.Top, C.Width, C.Height)
- B.Characters.Text = C
- B.LinkedCell = C.Offset(, 2).Address
- End If
- Next
- End With
- End Sub
|
|
發表於 2013-9-1 01:37
| 
發表於 2013-9-6 12:50
| 