在我的工作表 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
最佳答案
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
关于excel - 在特定单元格中创建 ActiveX 复选框,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/44450299/