[[20080821125615]]　『チェックボックスを連続データでコピー』（わたくしめ）　ページの最後に飛ぶ

『チェックボックスを連続データでコピー』（わたくしめ）

 ツールバーのフォームから，チェックボックスを作成しました。
 そして，「コントロールの書式設定」で「リンクするセル」を隣のセルに指定しました。
 このチェックボックスをたくさん作りたいので，下にセルコピーしたのですが，「リンクするセル」が，初期値のままで，連続したデータにできません。
 右クリックでコピーし，「連続データ」を選ぶこともできません。これは仕様なのでしょうか。
 やりたいイメージは下記のようなもので，これを1000行くらい作りたいので，いちいちコントロールの初期設定をしていたら大変なので・・・
 　　A　　B　　C　　D
 1　ロ　FALSE
 2　ロ　FALSE
 3　レ　TRUE
 4　ロ　FALSE
 5　レ　TRUE
 何か良い方法があれば教えていただけると幸いです。

 また，チェックの有無にかかわらず，すべてのチェックボックスを一括チェックしたり，一括でチェックを削除したりすることもできるのでしょうか。
 どうぞよろしくお願いします。

 >このチェックボックスをたくさん作りたいので，下にセルコピーしたのですが，
 >「リンクするセル」が，初期値のままで，連続したデータにできません。
 >いちいちコントロールの初期設定をしていたら大変なので・・・
 面倒ならマクロでやらせたらどうですか。
 私は自分で一回ポッキリのマクロを作って対応しましたけど。

 >すべてのチェックボックスを一括チェックしたり，一括でチェックを削除したりすることもできるのでしょうか。
 これはリンク先のセルの内容を消すか、Trueを書きこむとかすれば、一括でできます。
 BJ

どのようなマクロになるのでしょうか？どのようにマクロを作ればよいのでしょうか？
もしよろしければ教えていただけると大変ありがたいです。
どうかどうかよろしくお願いします。

 マクロが解ったところで、チェックボックスがある程度順番に並んでないと、
 望んだ結果になるとは思えませんが、取りあえず形だけ。

 また、チェックボックスの名前等もマクロで対応できるように付け直す事もあります。
 名前の変更も面倒なので、幸いにもこの程度のマクロがかける様には勉強したので、
 マクロで付け直す場合もあります。
 マクロが解らなければ、手動で地道な作業をするでしょうね。
 BJ

 Private Sub リンク設定()
 Dim Dobj As Shape
 For Each Dobj In ActiveSheet.Shapes
    If Dobj.FormControlType = xlCheckBox Then
       i = i + 1
       ActiveSheet.Shapes(Dobj.Name).OLEFormat.Object.LinkedCell = "=A" & i
    End If
 Next
 End Sub

 チェックボックスではなく、
 該当セルの値を書き換えるものですが・・・
 ご参考に。
[[20061020103946]]『クリックすると○の表示』（Ｃ）

 (HANA)

 チェエクボックスまでＶＢＡで作成してしまう方法もあります
（この場合は、Captionの作成にも何か便利になる機能を考えなければなりませんが、今回は省略）。

 標準モジュールに

 '==================================================================================
 Sub main()
    Dim mkrng As Range
    Dim lnkrng As Range
    Dim crng As Range
    Dim mcell() As Variant
    Dim g0 As Long
    Dim retcode As Long
    Set mkrng = get_sctrng("チェックボックスを作成するセル範囲を選択してください")
    If Not mkrng Is Nothing Then
       Set lnkrng = get_sctrng("対応するリンクセル範囲を選択してください")
       If Not lnkrng Is Nothing Then
          g0 = 1
          For Each crng In mkrng
             With mkrng.Parent.CheckBoxes.Add(crng.Left, _
                               crng.Top, _
                               crng.Width, _
                               crng.Height)
                .LinkedCell = lnkrng.Cells(g0).Address(, , , True)
                If g0 < lnkrng.Count Then g0 = g0 + 1
                End With
             Next
          End If
       End If
 End Sub
 '==================================================================================
 Function get_sctrng(Optional mes As String, Optional mxact As Long = 1) As Range
    Dim rng As Range
    Dim retcode As Long
    On Error Resume Next
    retcode = 1
    Set get_sctrng = Nothing
    Do Until retcode = 0
       Set rng = Application.InputBox(mes, , , , , , , 8)
       If Err.Number = 0 Then
          If rng.Areas.Count <= mxact Then
             Set get_sctrng = rng
             retcode = 0
             End If
       Else
          retcode = 0
          End If
       Loop
    On Error GoTo 0
 End Function

 として、mainを実行して見てください。

 最初にチェックボックス作成セル範囲と対応するリンクセル範囲を指定します。
 二つのセル範囲が指定されると、コントロールを作成します。

 尚、結合セルには対応していません。

 試してみてください

 ichinose

コメント返信：

[ 一覧(最新更新順) ]

[[20080821125615]] 『チェックボックスを連続データでコピー』（わたくしめ） ページの最後に飛ぶ

[[20080821125615]]　『チェックボックスを連続データでコピー』（わたくしめ）　ページの最後に飛ぶ