Excel VBA オプションボタンなどのコントロールを別シートに作成する

Question

現在、Excel（Mac）でボタンを押すと
別シートにオプションボタンを生成するマクロを作成中です。

単純にセル値を別シートにコピーすることは
ネットでもありふれていましたが、コントロールに関しては
ほとんどないみたいです。

詳細は、以下の通りです。

・「マスタ」シートには、ある項目の選択肢をセルに記録しています。
（例：牛肉 100,200,300など）
・上記の100, 200, 300をオプションボタンとして別シートに生成します。
・繰り返し生成したいため、オプションボタンはグループボックスで囲みます。

これを実現するために
VBAのコードでどのように書けば良いかを教えていただけないでしょうか？

どうぞよろしくお願いいたします。

以下のようなコードを作成しましたが、
「実行時エラー '1004':

このオブジェクトの作成元アプリケーションを起動できません。メモリが不足している可能性があります。」

というエラーが出てしまいます…。

Sub viewInputArea_Click()

    Dim i As Long, j As Long

    Dim workSheetInput As Worksheet
    Dim workSheetMaster As Worksheet
    Dim criteriaSheet As Object

    Set workSheetInput = ActiveWorkbook.Worksheets("入力エリア")
    Set workSheetMaster = ActiveWorkbook.Worksheets("マスタ")

    Dim colsData As Long
    Dim rowsData As Long
    rowsData = workSheetMaster.Cells(Rows.Count, 2).End(xlUp).Row

    Dim optBtn As OLEObject
    Dim criteriaCell As Range

    For i = 1 To rowsData - 1
        workSheetInput.Cells(7 + (i - 1), 2).Value = workSheetMaster.Cells(6 + (i - 1), 2).Value

        colsData = workSheetMaster.Cells(i, Columns.Count).End(xlToLeft).Column
        For j = 1 To colsData
            Set optBtn = workSheetInput.OLEObjects.Add( _
                ClassType:="Forms.OptionButton.1", _
                Link:=Flase, DisplayAsIcon:=False, _
                Left:=6.3, _
                Top:=2.1, _
                Width:=0.7, _
                Height:=0.35 _
            )
            optBtn.Object.Caption = workSheetMaster.Cells(6 + (i - 1), j).Value & 年
        Next j
    Next i
End Sub

Answer 1

質問本文とコードから、以下のような状態のマスターシートを読み、入力エリアシートに出力したいものと推測します。
＜マスタシート＞
・B列が品目、C列以降に選択候補
・明細の先頭行は６行目

＜入力エリアシート＞
・B列に品目を出力
・選択候補のオプションボタンを作成
・出力先頭行は７行目

前提の認識が誤っていたらすみませんがご指摘ください。

できていること

・別シートへのオプションボタン作成
まず質問の本題となっている別シートへのオプションボタン作成ですが、これは実現できているのではないでしょうか？

同様の現象を再現できなかったため推測しかできませんが、エラー内容からして単純なオプションボタンの作成でエラーとなっているようには思えません。
何らかの原因で（たとえばオプションボタンを作成しすぎて）メモリが不足し、処理が続行できなくなったものと思います。

マスタデータの量を減らす等して正常に動作するのであれば、エラーは別の問題（端末環境、データ量の問題）だと思います。

できていないこと

提示いただいたコードにはいくつか修正が必要な個所がありそうです。

●行ループの回数
マスタデータの取得位置から察して６行目が明細先頭行ではないかと思います。
行ループを行う回数として、
rowsData = workSheetMaster.Cells(Rows.Count, 2).End(xlUp).Row
でマスタシートのB列最終データ行を取得し、
For i = 1 To rowsData - 1
でループ処理していますが、開始行が6行目であれば必要以上にループすることになると思います。

●列ループの回数
列ループの回数も行ループと同様に
colsData = workSheetMaster.Cells(i, Columns.Count).End(xlToLeft).Column
で各列の最終データ列から取得しようとしていますが、まず取得対象としている行が誤っていると思います。
そしてループ処理を
For j = 1 To colsData
とすることで、A列から最終列まで全てを選択候補としてオプションボタンを作成してしまっていると思います。
選択候補がC列から開始であれば、ループの開始も3からになると思います。

●オプションボタンのキャプション名
オプションボタンのキャプション名の最後に& 年が記述されています。
年という変数を別途定義してあれば別ですが、"年"という文字列を出力したいのであれば& "年"としましょう。

●オプションボタンの出力位置
オプションボタンを常に同じ位置に出力している為、正しく出力されているように見えないと思います。
１つずつLeftとTopの出力位置を調整しましょう。

●オプションボタンのグルーピング
作成したオプションボタンは、おそらく行単位でグルーピングしたいのではないでしょうか？
提示いただいたコードの処理で作成されたオプションボタンは、全て同じグループに属してしまうため、作成したオプションボタンの中で１つしかチェックをつけることができなくなってしまいます。
行単位でグループ名を分けて作成しましょう。

サンプル

Sub viewInputArea_Click()
    Dim i As Long, j As Long    'ループカウンタ
    
    Dim workSheetInput As Worksheet     '作成シート
    Dim workSheetMaster As Worksheet    'マスタシート
    Dim criteriaSheet As Object
    
    Set workSheetInput = ActiveWorkbook.Worksheets("入力エリア")
    Set workSheetMaster = ActiveWorkbook.Worksheets("マスタ")
    
    Dim colsData As Long    '列ループ回数
    Dim rowsData As Long    '行ループ回数
    
    '最終行番号の取得
    rowsData = workSheetMaster.Cells(Rows.Count, 2).End(xlUp).Row
    
    Dim optBtn As OLEObject
    Dim criteriaCell As Range
    
    '行ループ
    'For i = 1 To rowsData - 1
    For i = 1 To rowsData - 5
        '品目の出力
        workSheetInput.Cells(7 + (i - 1), 2).Value = workSheetMaster.Cells(6 + (i - 1), 2).Value
        '最終列番号の取得
        'colsData = workSheetMaster.Cells(i, Columns.Count).End(xlToLeft).Column
        colsData = workSheetMaster.Cells(6 + (i - 1), Columns.Count).End(xlToLeft).Column
        '列ループ
        'For j = 1 To colsData
        For j = 3 To colsData
            'Set optBtn = workSheetInput.OLEObjects.Add( _
            '    ClassType:="Forms.OptionButton.1", _
            '    Link:=Flase, DisplayAsIcon:=False, _
            '    Left:=6.3, _
            '    Top:=2.1, _
            '    Width:=0.7, _
            '    Height:=0.35 _
            '    )
            
            'オプションボタンの配置（横位置はセルに合わせています）
            Set optBtn = workSheetInput.OLEObjects.Add( _
                ClassType:="Forms.OptionButton.1", _
                Link:=Flase, DisplayAsIcon:=False, _
                Left:=workSheetInput.Cells(7 + (i - 1), j).Left, _
                Top:=workSheetInput.Cells(7 + (i - 1), j).Top, _
                Width:=0.7, _
                Height:=0.35 _
                )
            'オプションボタン項目名
            optBtn.Object.Caption = workSheetMaster.Cells(6 + (i - 1), j).Value & "年"
            'グループ設定
            optBtn.Object.GroupName = "Group" & CStr(i)
        Next j
    Next i
End Sub

推測を多分に含んだ回答ですので、見当違いでしたら申し訳ありません。
参考になれば幸いです。

Comments

[TakuyaHidaka]

大変ありがとうございました。
非常に参考になり、こちらの作業も進みそうです。
フォローさせていただきましたのでよろしくお願いいたします。