在我的工作表1中,A列有一些值,我需要为特定单元格中Sheet 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
答案 0 :(得分: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