Excelチェックボックスのリンクするセル一括

質問

Excelでチェックボックスのリンクするセルを一括設定したいです。

sheet１に複数のチェックボックスを作成し、それぞれのリンクするセルをsheet2に入れたいのですが、チェックボックスが数10個あるので、1つづつやっていると手間がかかります。

例
sheet1のB2のリンクするセルをsheet2のB2
sheet1のB3のリンクするセルをsheet2のB3
sheet1のB4はsheet2のB4
…

一括でやる方法（多分VBA)はわかりますか。

回答No.2

HohoPapa · ベストアンサー

もし添付画像のように、チェックボックスの名前が
Check Box 1
Check Box 2
Check Box 3
...
といった1からの連番で、

Check Box 1　のリンクするセルがsheet2のB2
Check Box 2　のリンクするセルがsheet2のB3
Check Box 3　のリンクするセルがsheet2のB4
...

という設定になるのであれば、
以下のコードでイケルと思います。

Sub sample()

Dim sh As Shape

For Each sh In ActiveSheet.Shapes
sh.Select
Selection.LinkedCell = "Sheet2!$D$" & (Val(Right(sh.Name, 2)) + 1)
Next sh

End Sub

もしチェックボックスの名前からリンクするセルを求めることが困難であれば、

Sub abc()
　MsgBox Range("B2").Top
　MsgBox Range("B2").Height
End Sub
といったコードで、B2セルの開始位置と高さを提示してもらえば
別なコードを提示できると思います。

お礼

できました。ありがとうございます。

回答No.3

HohoPapa

https://okwave.jp/qa/q9964807.html
で紹介したコードを応用した、
後記コードはいかがでしょうか？

Sub sample()

　Dim sh As Shape
　Dim LineNum As Long

　For Each sh In ActiveSheet.Shapes
　　If Left(sh.Name, 9) = "Check Box" Then
　　　'何行目にあるかを調べる
　　　LineNum = SearchR(sh.Top + (sh.Height / 2))
　　　'リンクセルを設定
　　　sh.Select
　　　Selection.LinkedCell = "Sheet2!$D$" & Format(LineNum, "0")
　　End If
　Next sh

End Sub

'縦位置から該当行番号を取得する関数
Function SearchR(MyTop As Double) As Long

　Const MaxRows = 100　'最大行数
　Dim r As Long

　For r = 1 To MaxRows
　　If ((Cells(r, 1).Top < MyTop) And _
　　　　(Cells(r, 1).Top + Cells(r, 1).Height > MyTop)) Then
　　　SearchR = r
　　　Exit Function
　　End If
　Next r

End Function

回答No.1

aokii

下にドラッグアンドコピー

お礼

それができればいいのですがね。。。

関数ならそれでやってました。　回答ありがとうございます。