Excel VBA ActiveX标签的怪异行为

Question

我需要在一个工作表上放置多个复选框。Excel FormControl和ActiveX控件中的标准复选框选项太小。因此，我找到了一个使用this链接的解决方案。

基本上，您将创建一个ActiveX标签，该标签将被格式化为Wingdings字体。当用户点击标签时，宏基本上将字符从空框Wingdings Chr(168)更改为复选框Wingding Chr(254)。

如果手动创建标签并添加代码，一切都会正常工作。但我正在使用VBA创建这些标签并添加相应的Click事件代码。标签和代码正在创建中，但它并没有以应有的方式显示Chr(168)。创建后，如果您单击任何标签并转到其属性并单击字体，就会打开字体窗口。即使您不对此窗口执行任何操作(因为字体已经使用VBA设置)并关闭它，标签也会正确显示Chr(168)。

这是我的代码：

Public Function AddChkBox()
Dim sLabelName As String
Dim i As Integer
For i = 2 To 4  '~~> Actual number is big
sLabelName = "Label" & (i - 1)
With Sheets("Input").OLEObjects.Add(ClassType:="Forms.Label.1", Link:=False, _
DisplayAsIcon:=False, Left:=Range("B" & i).Left + 5, _
Top:=Range("B" & i).Top + 3, Width:=60, Height:=13)
.Name = sLabelName
.Object.Font.Name = "Wingdings"
.Object.Font.Size = 16
.Object.Caption = Chr(168)
.Object.TextAlign = fmTextAlignCenter
End With
Call InsertSub("Input", sLabelName, "Click")
Next
End Function
Public Function InsertSub(shtName As String, labelName As String, action As String)
' Code courtesy @Siddharth Rout
Dim wb As Workbook, ws As Worksheet
Dim VBP As Object, VBC As Object, CM As Object
Dim strProcName As String
strProcName = labelName & "_" & action
Set wb = ThisWorkbook
Set ws = wb.Sheets(shtName)
Set VBP = wb.VBProject
Set VBC = VBP.VBComponents(ws.CodeName)
Set CM = VBC.CodeModule
With wb.VBProject.VBComponents( _
wb.Worksheets(ws.Name).CodeName).CodeModule
.InsertLines Line:=.CreateEventProc(action, labelName) + 1, _
String:=vbCrLf & _
"   If " & labelName & ".Caption = Chr(254) Then" & vbCrLf & _
"       'box with no checkmark" & vbCrLf & _
"       " & labelName & ".Caption = Chr(168)" & vbCrLf & _
"       " & labelName & ".ForeColor = -2147483640" & vbCrLf & _
"   Else" & vbCrLf & _
"       'box with a checkmark" & vbCrLf & _
"       " & labelName & ".Caption = Chr(254)" & vbCrLf & _
"       " & labelName & ".ForeColor = 32768" & vbCrLf & _
"   End If"
End With
End Function  

对此有什么想法吗。。。？

Answer 1

您没有更改字体的Charset，Wingdings将无法使用默认字符集。只要把它改成2，你就做好了。

//......
.Name = sLabelName
.Object.Font.Name = "Wingdings"
'/ Need to add the charset. Default is 1. Change it to 2.
.Object.Font.Charset = 2
.Object.Font.Size = 16
//......

字符集-->1=DEFAULT_Charset

字符集-->2=SYMBOL_Charset