Excel VBA ActiveX 标签奇怪的行为

Question

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

基本上，您将创建一个将格式化为 Wingdings 字体的 ActiveX 标签。当用户单击标签时，宏基本上将字符从空框 Wingdings Chr(168) 更改为选中框 Wingdings 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