- Excel VBA 質問スレ Part38 [転載禁止]©2ch.net
44 ：デフォルトの名無しさん[sage]：2015/09/13(日) 09:21:02.53 ID:Jm5r3jb9 - 拾い物で、恐縮なんですが、チェックボックスがフォームで作成されるんですが、
ActiveXに変更できないでしょうか？
'==================================================================================
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
'==================================================================================
| - Excel VBA 質問スレ Part38 [転載禁止]©2ch.net
45 ：デフォルトの名無しさん[sage]：2015/09/13(日) 09:21:55.18 ID:Jm5r3jb9 - 続きです
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
お願いいたします。
|
|