Question

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

基本上，您将创建一个ActiveX标签，格式为Wingdings字体。当用户点击标签时，宏基本上将字符从空框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
//......

Charset - ＆gt; 1 = DEFAULT_CHARSET

Charset - ＆gt; 2 = SYMBOL_CHARSET

Excel VBA ActiveX Label奇怪的行为

1 个答案: