質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

ただいまの
回答率

88.61%

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

解決済

回答 1

投稿 編集

  • 評価
  • クリップ 0
  • VIEW 3,847

TakuyaHidaka

score 138

現在、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
  • 気になる質問をクリップする

    クリップした質問は、後からいつでもマイページで確認できます。

    またクリップした質問に回答があった際、通知やメールを受け取ることができます。

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 過去に投稿した質問と同じ内容の質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

回答 1

checkベストアンサー

+1

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

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

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

できていること

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

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

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

できていないこと

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

●行ループの回数
マスタデータの取得位置から察して6行目が明細先頭行ではないかと思います。
行ループを行う回数として、
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からになると思います。

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

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

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

サンプル

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

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

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2016/12/19 17:16

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

    キャンセル

15分調べてもわからないことは、teratailで質問しよう!

  • ただいまの回答率 88.61%
  • 質問をまとめることで、思考を整理して素早く解決
  • テンプレート機能で、簡単に質問をまとめられる

関連した質問

同じタグがついた質問を見る