在特定单元格中创建 ActiveX 复选框

Question

在我的工作表 1 中，A 列有一些值，我需要为工作表 2 中特定单元格中的所有值创建一个 Active X 复选框。首先，我需要检查 Active X 复选框是否存在该值，如果不存在，我需要创建。我已经尝试了下面的代码，但是它创建了重复的复选框。

Sub Addcheckbox()
Dim rng As Range, cell As Range
Dim rr As Integer
Dim tf As Boolean
Dim shpTemp As Shape

Set rng = Range("A1:A8")
Set Destrng = Range("A2:A9")
rr = 2
For Each cell In Worksheets("Sheet1").Range("A1:A8")
    If Not IsEmpty(cell.Value) Then
     With ActiveSheet.OLEObjects.Add(ClassType:="Forms.CheckBox.1", _
        Left:=51.75, Top:=183, Width:=120, Height:=19.5)
        .Object.Caption = cell.Value
    End With
    End If
rr = rr + 1
Next cell
End Sub

如何使用标题名称检查工作表中是否已存在 ActiveX 复选框

我试过这段代码来检查复选框。但它不起作用..

Function shapeExists(ByRef shapename As String) As Boolean

    shapeExists = False
    Dim sh As Shape
    For Each sh In ActiveSheet.Shapes
        If sh.name = shapename Then
            shapeExists = True
            Exit Function
        End If
    Next sh


End Function

Answer 1

ActiveX 复选框为OleObjects。这是你正在尝试的吗？

您还需要指定正确的.Top，否则它们将在同一位置创建。看看我是如何使用Top:=cell.Top

Sub Sample()
    Dim rng As Range, cell As Range
    Dim rr As Integer
    Dim tf As Boolean
    Dim shpTemp As Shape

    Set rng = Range("A1:A8")
    Set Destrng = Range("A2:A9")

    rr = 2

    For Each cell In Worksheets("Sheet1").Range("A1:A8")
        If Not IsEmpty(cell.Value) Then
            If Not CBExists(cell.Value) Then '<~~ Check if the checkbox exists
                With ActiveSheet.OLEObjects.Add(ClassType:="Forms.CheckBox.1", _
                        Left:=51.75, Top:=cell.Top, Width:=120, Height:=19.5)
                        .Object.Caption = cell.Value
                End With
            End If
        End If
        rr = rr + 1
    Next cell
End Sub

'~~> Function to check if the checkbox exists
Function CBExists(s As String) As Boolean
    Dim oleObj As OLEObject
    Dim i As Long

    For i = 1 To Worksheets("Sheet1").OLEObjects.Count
        If s = Worksheets("Sheet1").OLEObjects(i).Object.Caption Then
            CBExists = True
            Exit Function
        End If
    Next i
End Function