Excel VBA ActiveX標籤怪異行爲

Question

我需要將多個複選框放在工作表上。 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 
//...... 

字符集 - > 1 = DEFAULT_CHARSET

字符集 - > 2 = SYMBOL_CHARSET