エクセルVBAで結合セルの真ん中にチェックボックスを作成する方法を教え

質問

エクセルVBAで結合セルの真ん中にチェックボックスを作成する方法を教えて下さい。

数個下の質問で結合されたセルに一つだけチェックボックスを作る方法を質問した者です。
度々すみません。

今度の質問ですが、結合したセルの上下左右の真ん中にチェックボックスを作る方法を教えていただけないでしょうか？

現在のプログラムは下記のようになっております。

宜しくお願い致します。

Dim ss As Excel.Range, cbx As CheckBox
With Selection.Parent
For Each ss In Selection
If (ss.MergeArea.Column = ss.Column) * (ss.MergeArea.Row = ss.Row) Then
Set cbx = .CheckBoxes.Add(Left:=ss.Left, Top:=ss.Top, _
Height:=ss.Height, Width:=ss.Width)
cbx.Text = ""
RowCnt = Selection.Row　　　　　　　　'選択されているセルの行をRowCnt変数で表現
cbx.LinkedCell = "A" & RowCnt　　　　'選択されているセルのA列にチェックボックスを作成
cbx.Display3DShading = False　　　　　'3D表示なし
With cbx.ShapeRange
.Fill.Solid
.Fill.Visible = msoFalse　　　　　　　'塗りつぶしなし
.Line.Visible = False　　　　　　　　　'線on,off
.Line.Weight = 0.25　　　　　　　　　　'線幅
.Line.ForeColor.RGB = RGB(0, 0, 0)　　'線色
End With
End If
Next
End With

回答No.1

jcctaira · ベストアンサー

> Set cbx = .CheckBoxes.Add(Left:=ss.Left, Top:=ss.Top, _
> Height:=ss.Height, Width:=ss.Width)
を以下のように修正すれば「ほぼ」セルの中央に表示されると思います。

　Set cbx = .CheckBoxes.Add(Left:=0, Top:=0, Height:=0, Width:=0)
　cbx.Top = ss.Top + (ss.MergeArea.Height - cbx.Height) / 2
　cbx.Left = ss.Left + (ss.MergeArea.Width - cbx.Width) / 2

補足説明）
　・「Height:=0, Width:=0」チェックボックスのサイズが分からないので一番小さなサイズを設定
　　しています。
　・実際は０にはならず、最低限のサイズになります。

お礼

はい。
ほぼ真ん中でまったく問題ありません。
私もほぼ真ん中にしか実際無理なんじゃないかと思っていたところです。

シンプルな方法でご教授いただきまして本当にありがとうございました＾＾

回答No.2

imogasi

列幅のみ問題にしてみます。エクセルでは列幅ColumnWidthは文字数で表されるらしいのですが、
http://d.hatena.ne.jp/Nikki_A/20080104
これらとセルのLEFTなどの単位（ピクセル、ポイントなどの関係）の合わせ方が小生の力不足の苦手分野で、自信はありませんが、やってみました。
チェックボックスを動的に作成するのでなく、簡単のために手動で設けて、横位置のみ追求してみました。
チェックボックスの動的作成も、VBA程度では、あまり話題にしません。
チェックボックスの幅は、画面で見た目でなく、デザインモードでのハンドルの四角の横幅を問題にせざるを得ないです。チェックボックスのCattionの文字数で考えると、違ったものになります。
下記は結合セルの最左セルを問題（既定）にして、固定してます。
何処に（どの列に）結合セルがあるか不定の場合で捉えるのは、
http://officetanaka.net/excel/vba/tips/tips50.htmなど見てください。
結合セルのセル数は自動で捉えます。
このへんのコードは役立つかも。
Sub test01()
buf = 0
Set mcl = Worksheets("Sheet1").Range("C10")
If Range("C6").MergeCells Then
For Each cl In mcl.MergeArea
buf = buf + cl.ColumnWidth
MsgBox cl.Address
Next
MsgBox "結合セルセル合計文字数　" & buf & Application.InchesToPoints(buf)
z = buf * 72 / 8.38
x = mcl.Left
MsgBox mcl.Address & "セルLEFT　" & Application.InchesToPoints(x)
y = Worksheets("Sheet1").CheckBox1.Width
MsgBox "チェックボックス幅　" & Application.InchesToPoints(y)
MsgBox (z - y) / 2
Worksheets("Sheet1").CheckBox1.Left = x + (z - y) / 2
'Application.InchesToPoints(Worksheets("Sheet1").CheckBox1.Width)) / 2
Else
MsgBox mcl.Address & "-->結合されていません" & vbCrLf
End If

End Sub
ーーーー
普通のやり方は、図形を捉える斜め矢印でチェックボックス群を捉え、図形の調整ー配置整列で（そしてVBAでやるならそのVBAマクロ記録などで知る）やるのではないでしょうか。質問は凝りすぎで、問題を難しくしているように思います。

お礼

ご丁寧にありがとうございました。

勉強になりました。