Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


29799 / 76732 ←次へ | 前へ→

【52207】Re:チェックボックスの大きさ変更について
発言  ichinose  - 07/10/30(火) 18:48 -

引用なし
パスワード
   とも さん、Jakaさん、こんばんは。

先日、同じようなご質問を受けました。
但し、その質問では、シートに配置するチェックボックスの四角の大きさを
大きくしたい ということでした。

図形を使って自作するしかないと回答しました。

標準モジュールに
'=================================================================
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
  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))
       .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))
       .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
 
End Sub
'===============================================================
Function get_mkobj_cond() As Variant
  Const sz = 11
  Dim rng As Range
  Dim cond(1 To 3) As Variant
  get_mkobj_cond = False
  cond(1) = Application.InputBox("チェックボックスのテキストを入力してください")
  If TypeName(cond(1)) <> "Boolean" Then
    cond(2) = Application.InputBox("文字サイズを11〜48の範囲で指定してください", , sz)
    If TypeName(cond(2)) <> "Boolean" Then
     If Val(cond(2)) >= 11 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)
        get_mkobj_cond = cond()
        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を実行してみてください。

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

仮に「Excel VBA質問箱」(両端の「」は除く)と指定してOKボタンを
クリックしてください。

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

(例 36)

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

文字サイズに応じたチェックボックスが作成されます。

作成されたチェックボックスをクリックしてみてください。
チェックが付いたり消えたりします。


と回答しました。

試してみてください。

尚、チェックボックスがユーザーフォーム配置の場合は、
ラベルを使って似たようなことをしなけれななりませんが・・・。
0 hits

【52204】チェックボックスの大きさ変更について とも 07/10/30(火) 13:07 質問
【52205】Re:チェックボックスの大きさ変更について Jaka 07/10/30(火) 14:52 発言
【52206】Re:チェックボックスの大きさ変更について とも 07/10/30(火) 18:15 お礼
【52207】Re:チェックボックスの大きさ変更について ichinose 07/10/30(火) 18:48 発言
【52443】Re:チェックボックスの大きさ変更について とも 07/11/14(水) 16:03 回答

29799 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free