[[20080908154905]]　『チェックボックス』（スガベルト）　ページの最後に飛ぶ

『チェックボックス』（スガベルト）

チェックボックスを挿入したんですが
印刷するとレ点が細く見づらいです

このレ点を太く又は色を変えることは出来るのでしょうか？

宜しくお願い致します

 >レ点を太く又は色を変えることは
 こういうことは、チェックボックスを自作するしかないと思いますが・・・。

 以前、別サイトで近い御質問に投稿したことがあります。

http://www.vbalab.net/vbaqa/c-board.cgi?cmd=one;no=52207;id=excel

 上記を少し変更して、

 新規ブックの標準モジュールに

 '=================================================================================
Option Explicit
 '===============================================================
 Sub mk_mycheckbox()
    Dim sp1 As Shape
    Dim sp2 As Shape
    Dim t_sz As Variant
    Dim cond As Variant
    Dim rng As Range
    On Error Resume Next
    Set rng = Selection
    cond = get_mkobj_cond
    If TypeName(cond) <> "Boolean" Then
       With rng
          Set sp1 = .Parent.Shapes.AddShape(msoShapeRectangle, .Left, .Top, Val(cond(2)), Val(cond(2)))
          sp1.Fill.Solid
          With sp1.TextFrame
             .Characters.Text = ChrW(10003)
             .HorizontalAlignment = xlCenter
             .VerticalAlignment = xlCenter
             .Characters.Font.Size = Val(cond(2))
             .Characters.Font.ColorIndex = cond(4)
             .Characters.Font.Bold = cond(5)
             .AutoSize = True
             DoEvents
             .AutoSize = False
             .Characters.Text = ""
             End With
          Set sp2 = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, sp1.Left + sp1.Width + 7.5, sp1.Top, Val(t_sz), Val(t_sz))
          sp2.Fill.Solid
          sp2.Line.Visible = msoFalse
          With sp2.TextFrame
             .Characters.Text = cond(1)
             .Characters.Font.Size = Val(cond(2))
             .Characters.Font.ColorIndex = cond(4)
             .Characters.Font.Bold = cond(5)
             .HorizontalAlignment = xlCenter
             .VerticalAlignment = xlCenter
             .AutoSize = True
             End With
          With .Parent.Shapes.Range(Array(sp1.Name, sp2.Name)).Group
             .OnAction = "mycheck_Click"
             Application.Range(cond(3)).Name = "L" & Replace(.Name, " ", "")
             Application.Range(cond(3)).Value = False
             End With
          End With
       End If
    On Error GoTo 0
 End Sub
 '===============================================================
 Function get_mkobj_cond() As Variant
    Const sz = 11
    Dim ans As Long
    Dim rng As Range
    Dim cond(1 To 5) As Variant
    get_mkobj_cond = False
    cond(1) = Application.InputBox("チェックボックスのテキストを入力してください")
    If TypeName(cond(1)) <> "Boolean" Then
       cond(2) = Application.InputBox("文字サイズを８～４８の範囲で指定してください", , sz)
       If TypeName(cond(2)) <> "Boolean" Then
          If Val(cond(2)) >= 8 And Val(cond(2)) <= 48 Then
             On Error Resume Next
             Set rng = Application.InputBox("リンクセルを選択して下さい", , , , , , , 8)
             If Err.Number = 0 Then
                cond(3) = rng.Address(, , , True)
                cond(4) = Application.InputBox("文字及び、チェックの色をパレット番号で指定して下さい")
                If IsNumeric(cond(4)) Then
                   ans = MsgBox("太字にしますか?", vbYesNoCancel)
                   If ans <> vbCancel Then
                      If ans = vbYes Then
                         cond(5) = True
                      Else
                         cond(5) = False
                         End If
                      get_mkobj_cond = cond()
                      End If
                   End If

                End If
             On Error GoTo 0
             End If
          End If
       End If
    Erase cond()
 End Function
 '===================================================================================
 Sub mycheck_Click()
    Dim ref As String
    Dim gnm As String
    Dim shp As Shape
    Dim ss As Shape
    Dim nm() As Variant
    Dim g0 As Long
    If TypeName(Application.Caller) = "String" Then
      Set shp = ActiveSheet.Shapes(Application.Caller).ParentGroup
      ref = "L" & Replace(shp.Name, " ", "")
      For Each ss In shp.GroupItems
          ReDim Preserve nm(g0)
          nm(g0) = ss.Name
          g0 = g0 + 1
          Next
      gnm = shp.Name
      shp.Ungroup
      With ActiveSheet
          For g0 = LBound(nm()) To UBound(nm())
            With .Shapes(nm(g0))
                If .Type = 1 Then
                  With .TextFrame.Characters
                      If .Text = "" Then
                        .Text = ChrW(10003)
                        Application.Range(ref).Value = True
                      Else

                        .Text = ""
                        Application.Range(ref).Value = False
                        End If
                      End With

                  Exit For
                  End If
                End With
            Next
          End With
      With ActiveSheet.Shapes.Range(nm()).Regroup
          .Name = gnm
          End With
      End If
 End Sub

使用方法

 これで適当なセルを選択した状態でmk_mycheckboxを実行してみてください。

 チェックボックスのテキストの入力を促されますから、

 仮に「エクセルの学校」（両端の「」は除く）と指定してＯＫボタンを
 クリックしてください。

 次に文字のサイズの入力を促されますから、8から48の間で指定してＯＫボタンを
 クリックしてください。

（例　36）

 チェックの有無をリンクするセルを選択してください。

 文字の色をパレット番号で指定して下さい（例　0（黒）とか　3（赤）等等）。

 太字するか否かの指定をしてください。

 これらの条件が正しく入力されると、文字サイズや色に応じたチェックボックスが作成されます。

 作成されたチェックボックスをクリックしてみてください。
 チェックが付いたり消えたりします。
 (リンクしたセルには、True　Falseが表示されます）

 試してみてください。

 ichinose

コメント返信：

[ 一覧(最新更新順) ]

[[20080908154905]] 『チェックボックス』（スガベルト） ページの最後に飛ぶ

[[20080908154905]]　『チェックボックス』（スガベルト）　ページの最後に飛ぶ