CODEWITHSUNDEEP
excelcheckboxvba
user2731629
user2731629

Reputation: 412

Create ActiveX checkbox in specific cell

In my Sheet 1, Column A has some values and I need to create a Active X checkbox for all the values in Sheet 2 in a specific cell. First I need to check whether Active X checkbox is there for the value or not, If its not there, I need to create. I already tried the below code, But its creating the duplicate checkboxes. 

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

How to check whether ActiveX checkbox already present in the sheet or not with Caption name

i tried this code for checking the checkboxes.. But its not working..

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

Upvotes: 2

Views: 2388

Answers (1)

Siddharth Rout
Siddharth Rout

Reputation: 149305

ActiveX Checkboxes are OleObjects. Is this what you are trying?

Also you need to specify the correct .Top else they will be created at the same place. See how I used 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

Upvotes: 1

Related Questions