エクセルVBAで動的にコンボボックスを作成

一枚のシートに動的に複数のコンボボックスとコマンドボタンを生成しようとしています。
標準モジュールのループでコントロールを生成していますが、一周は上手く回るのですが、２週目から
コンボボックス作成MakeComboの中のここでおちると記載している部分でエクセルのアプリケーションエラーに
なってしまい、エクセルが落ちてしまいます。

With clsExcel.objWs
'コンボボックスの位置を指定
Dim cmbPos As Range
Set cmbPos = .Range(.Cells(k, 4), .Cells(k, 4))
'コンボボックスを作成
Set m_objOLE_C = .OLEObjects.Add(ClassType:="Forms.ComboBox.1", Link:=False,DisplayAsIcon:=False, _
Left:=cmbPos.Left, Top:=cmbPos.Top, Width:=63, Height:=15)
End With

Dim objCmb As ComboBox
Set objCmb = clsExcel.objWs.OLEObjects(m_objOLE_C.name).Object
objCmb.Locked = False

With objCmb
'--コンボボックスに初期値をセット
.AddItem "計", 0
.AddItem "推", 1
.AddItem "確", 2
.AddItem "積", 3
'--------------------------------------------
' For j = 0 To 3
' If strData = .List(j) Then
' .ListIndex = j'<-----ここでおちる
' Exit For
' End If
' Next j
'--------------------------------------------
End With

Set cmbPos = Nothing
Set objCmb = Nothing
Set m_objOLE_C = Nothing
End Sub

No.1 ベストアンサー 回答者： ja7awu 回答日時： 2003/04/23 09:14

先頭部分を省いていますが、全体でないと調べにくいでぇ～す。

たぶん、これでいいと思いますが・・・・
Set objWs = clsExcel.ActiveSheet　にした方がいいかと思います。

変数 k と strData は、何処で設定しているか解らないので取り敢えず
仮に　k = 1 , strData = "積" としてテストしています。

Sub tariran()
Dim clsExcel As Workbook
Dim objWs As Worksheet
Dim cmbPos As Range
Dim m_objOLE_C As Object
Dim objcmb As Object
Dim strData As String
Dim j As Integer
Dim k As Integer
Set clsExcel = ThisWorkbook
Set objWs = clsExcel.ActiveSheet
With objWs
　　'コンボボックスの位置を指定
　　k = 1 '<---------------------------仮設定
　　Set cmbPos = .Range(.Cells(k, 4), .Cells(k, 4))
　　'コンボボックスを作成
　　Set m_objOLE_C = .OLEObjects.Add(ClassType:="Forms.ComboBox.1", _
　　　　Link:=False, DisplayAsIcon:=False, Left:=cmbPos.Left, _
　　　　Top:=cmbPos.Top, Width:=63, Height:=15)
End With
Set objcmb = objWs.OLEObjects(m_objOLE_C.Name).Object
objcmb.Locked = False
With objcmb
　　'--コンボボックスに初期値をセット
　　.AddItem "計", 0
　　.AddItem "推", 1
　　.AddItem "確", 2
　　.AddItem "積", 3
　　strData = "積" '　<---------------仮設定
　　For j = 0 To 3
　　　　If strData = .List(j) Then
　　　　　　.ListIndex = j '<-----ここでおちる
　　　　　　Exit For
　　　　End If
　　Next j
End With
Set clsExcel = Nothing
Set objWs = Nothing
Set cmbPos = Nothing
Set objcmb = Nothing
Set m_objOLE_C = Nothing
End Sub

この回答へのお礼

ありがとうございます。
コード全部は文字数がオーバーして記述できませんでした。すみません。。
参考にさせていただきます。
ありがとうございました。

お礼日時：2003/04/25 20:38