excel vbaでset comboboxが実行時エラー1004になって作成に失敗する

Question

実現したいこと

*j1セルにh4:h122のなかから値を選択するコンボボックスを作りたい
のですが、
set comboboxで実行時エラー1004になります。
コードは

    Set comboBox = Sheet1.OLEObjects.Add(ClassType:="Forms.ComboBox", Left:=Range("J1").Left, Top:=Range("J1").Top, Width:=100, Height:=20).Object

参照設定でマイクロソフトフォームズも追加しましたし、文法の間違えもGeminiで確認してみましたが、指摘されることは特段ありませんでした。
VBAは今回が初めてなので、あまりかってがわかりませんが、ご教授お願いします。
*実現したいことは
j1セルにコンボボックスを作成し、そのコンボボックスでh4:h122の範囲を選択し、その選択したセル番地をk3セルに価参照形式で書き込みたいのです。
*コード全体はこんな感じです
標準モジュール

'マクロ実行の起点（コンボボックス作成と初期化）
Sub ExecuteMacro()
    'コンボボックスの作成と初期化
    Call CreateAndInitializeComboBox
End Sub

'コンボボックスの作成と初期化
Sub CreateAndInitializeComboBox()
    Dim comboBox As Object

    'Sheet1をアクティブにする
    Sheet1.Activate
    'Sheet1の保護を解除（パスワードが設定されている場合は、Password:="パスワード"を追加）
    Sheet1.Unprotect
    '既存のコンボボックスを削除
For Each obj In Sheet1.OLEObjects
    If TypeOf obj.Object Is MSForms.comboBox Then
        obj.Delete
    End If
Next obj
    'コンボボックスの作成
    Set comboBox = Sheet1.OLEObjects.Add(ClassType:="Forms.ComboBox", Left:=Range("J1").Left, Top:=Range("J1").Top, Width:=100, Height:=20).Object
    'コンボボックスの初期化
    Call InitializeComboBox(comboBox)
End Sub

'コンボボックスの初期化と更新
Sub InitializeComboBox(comboBox As Object)
    Dim i As Long
    Dim month As Long
    Dim year As Long

    'コンボボックスのクリア
    comboBox.Clear

    'コンボボックスに選択肢を追加
    For i = 4 To 122
        month = i - 3
        year = Int((month - 1) / 12)
        month = (month - 1) Mod 12 + 1

        If year = 0 Then
            comboBox.AddItem month & "カ月目"
        Else
            comboBox.AddItem year & "年" & month & "カ月目"
        End If
    Next i

    'コンボボックスの初期値を設定（1カ月目）
    comboBox.Value = "1カ月目"
End Sub

'セルの値を更新
Sub UpdateCellValue(comboBox As Object)
    Dim selectedIndex As Long
    Dim selectedCell As String
    Dim formulaCell As String
    Dim formulaValue As String
    Dim divisor As Double
    Dim result As Double

    '選択されたコンボボックスのインデックスを取得
    selectedIndex = comboBox.ListIndex

    '選択されたセル番地を取得
    selectedCell = "H" & (selectedIndex + 4)

    '選択されたセル番地をK3セルに書き込む
    Sheet1.Range("K3").Value = "=" & selectedCell

    '選択された行のG列の式を取得
    formulaCell = "G" & (selectedIndex + 4)
    formulaValue = Sheet1.Range(formulaCell).formula

    '式の中から10000, 11000, 12000, 13000, 14000のいずれかを探す
    divisor = GetDivisor(formulaValue)

    '除算結果をL3セルに表示
    If divisor <> 0 Then
        result = Evaluate(selectedCell) / divisor
        Sheet1.Range("L3").Value = result
    Else
        Sheet1.Range("L3").Value = ""
    End If

    'M3:Q3セルの式を更新
    UpdateFormulaRange result, divisor
End Sub

'式の中から除数（10000, 11000, 12000, 13000, 14000）を探す
Function GetDivisor(formula As String) As Double
    Dim divisors As Variant
    Dim i As Long

    divisors = Array(10000, 11000, 12000, 13000, 14000)

    For i = 0 To UBound(divisors)
        If InStr(1, formula, divisors(i)) > 0 Then
            GetDivisor = divisors(i)
            Exit Function
        End If
    Next i
End Function

'M3:Q3セルの式を更新
Sub UpdateFormulaRange(result As Double, divisor As Double)
    Dim cell As Range

    For Each cell In Sheet1.Range("M3:Q3")
        cell.formula = "=" & result & "*" & (500 - (cell.Column - 13) * 100)
    Next cell

    '除数に応じた係数をM3セルに適用
    If divisor = 14000 Then
        Sheet1.Range("M3").formula = "=" & result & "*" & 500 & "*0.79685"
    ElseIf divisor = 13000 Then
        Sheet1.Range("M3").formula = "=" & result & "*" & 500 & "*0.79685"
        Sheet1.Range("N3").formula = "=" & result & "*" & 400 & "*0.79685"
    ElseIf divisor = 12000 Then
        Sheet1.Range("M3").formula = "=" & result & "*" & 500 & "*0.79685"
        Sheet1.Range("N3").formula = "=" & result & "*" & 400 & "*0.79685"
        Sheet1.Range("O3").formula = "=" & result & "*" & 300 & "*0.79685"
    ElseIf divisor = 11000 Then
        Sheet1.Range("P3").formula = "=" & result & "*" & 200 & "*0.79685"
    ElseIf divisor = 10000 Then
        Sheet1.Range("Q3").formula = "=" & result & "*" & 100 & "*0.79685"
    End If
End Sub

シートモジュール

'コンボボックスの値が変更されたときの処理
Private Sub ComboBox1_Change()
    Call UpdateCellValue(ComboBox1)
End Sub

*これから少しずつ勉強しようと思うので
是非実現にご尽力いただけますようお願いします。

発生している問題・分からないこと

excel VBAでコンボボックスを作成する方法がうまくいかない

該当のソースコード

特になし
```

### 試したこと・調べたこと
- [x] teratailやGoogle等で検索した
- [x] ソースコードを自分なりに変更した
- [ ] 知人に聞いた
- [ ] その他

##### 上記の詳細・結果
Geminiにも何度も質問しましたが、解決できずGoogleで検索もしましたが、同じようなことを解説してくれているページを見つけられませんでした。

### 補足
特になし

Answer 1

set comboboxで実行時エラー1004になります。

まず OLEObjects オブジェクトの Add メソッドの引数 ClassType に渡す文字列を "Forms.ComboBox.1" に変更して下さい。

Set comboBox = Sheet1.OLEObjects.Add(ClassType:="Forms.ComboBox.1", Left:=Range("J1").Left, Top:=Range("J1").Top, Width:=100, Height:=20).Object

それでも実行時エラー 1004 が発生するのであれば、恐らく Excel のトラストセンターの設定により ActiveX コントロールが無効になっているのではないかと思われます。
（特に Office 2024 においては、既定の設定により ActiveX コントロールは無効化されています）

j1セルにコンボボックスを作成し、そのコンボボックスでh4:h122の範囲を選択

J1 セルにデータの入力規則を設定なさればよいのではないでしょうか。

Comments

[phpsyoshinsya]

ご回答ありがとうございます。
修正していただいたコードを適応させて、トラストセンターのアクティブコントロールの設定も行って、エラーは表示されなくなりました。ただ、コンボボックスが表示されません。まだ何か直す個所がありますでしょうか？たしかに入力規則という方法もあると思いますが、それでも1カ月目2か月目のような表示で選択式にできるでしょうか？そしてその選んだセル番地をk3セルに価参照形式で書き込めるでしょうか？VBAにもエクセルにも詳しくなくて、基礎的な質問も含まれていて申し訳ありませんが、何卒ご教授いただけますようお願いいたします。

[sk.exe]

> コンボボックスが表示されません。まだ何か直す個所がありますでしょうか？

コードそのものに関しては、私が示した修正箇所を除けば特に見当たりません。
少なくとも、こちらの環境でテストした限りでは正常にコンボボックスが作成されます。
したがって、何か他の原因を疑われた方がよいと思います。

> たしかに入力規則という方法もあると思いますが、
> それでも1カ月目2か月目のような表示で選択式にできるでしょうか？

リストの参照先となるセル範囲の各セルの実際の値がそのようになっていれば一応は可能でしょうけど、実際の H4:H122 が "1カ月目"、"2カ月目"、"3カ月目"……といったリストになっているのか否かが不明瞭です。

また UpdateCellValue、GetDivisor、UpdateFormulaRange の各プロシージャのコードを拝見した限り「数値リテラルと算術演算子のみで構成された（他のセルの参照を含まない）数式を設定する」という表計算ソフトらしからぬ手法が用いられており、VBAに頼らずに解決できる方法があるようにも思えます。

とりあえず、Sheet1 の H4:H122 および G4:G122 の各セルにどのようなデータが格納されているか、どのような数式が設定されているかについて具体的に明記されることをお奨めします。

Answer 2

こんな感じかと。。。

標準モジュール

Option Explicit

'コンボボックスの作成と初期化
Sub ComboBox_Initialize()
    Dim wsh As Worksheet: Set wsh = Worksheets("Sheet1")
    Dim rngCmbBox As Range: Set rngCmbBox = wsh.Range("J1")
    Dim rngReference As Range: Set rngReference = wsh.Range("L4:H122")
    
    '既存のコンボボックスを削除
    ComboAllDelete wsh
    'コンボボックスの作成
    ComboCreate rngCmbBox, rngReference
End Sub

Private Sub ComboAllDelete(ByRef pWsh As Worksheet)
    Dim o As OLEObject
    
    For Each o In pWsh.OLEObjects
        If TypeName(o.Object) = "ComboBox" Then o.Delete
    Next
End Sub

Private Sub ComboCreate(ByRef prngCmb As Range, _
                        ByRef prngRef As Range)
    Dim cmb As MSForms.ComboBox
    Dim c As Range
    Dim i As Long, y As Long
    
    With prngCmb
        Set cmb = .Worksheet.OLEObjects.Add( _
              ClassType:="Forms.ComboBox.1", _
              Link:=False, DisplayAsIcon:=False, _
              Left:=.Left, Top:=.Top, Width:=100, Height:=20).Object
    End With
    cmb.List = GetChoices(prngRef)
    prngCmb.Value = prngRef.Address(External:=True)
End Sub

Private Function GetChoices(ByRef r As Range) As Variant
    Dim vList() As Variant
    Dim c As Range
    Dim i As Long
    Dim y As Long
    Dim m As Long
    Dim s As String
    ReDim vList(0 To r.Count - 1) As Variant
    For i = LBound(vList) To UBound(vList)
        y = Int(i / 12)
        m = i Mod 12 + 1
        If y = 0 Then
            s = m & "カ月目"
        Else
            s = y & "年" & m & "カ月目"
        End If
        vList(i) = s
    Next
    GetChoices = vList
End Function

シートモジュール

Option Explicit

Private Sub ComboBox1_Change()
    SetUpdate Me.Range("H3:K3"), Me.ComboBox1
End Sub

Private Sub SetUpdate(ByRef ToRange As Range, _
                    ByRef cmb As MSForms.ComboBox)
    Dim rngReference As Range
    Set rngReference = Application.Range(Me.Range("J1").Value)
    ToRange(1).Value = rngReference(cmb.ListIndex + 1, 1).Value
    ToRange(2).Value = result
End Sub