Excel VBA ActiveX Label変わった動作

Question

ワークシートに複数のチェックボックスを入れる必要がありました。 Excel FormControlとActiveXコントロールの標準チェックボックスオプションが小さすぎます。だから、私はthisリンクを使用して回避策を見つけました。

基本的には、WingdingsフォントとしてフォーマットされるActiveX Labelを作成します。マクロは基本的に、ユーザーがラベルをクリックすると、空のボックス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