• 締切済み

コンボボックスのダウンリストの行

フォームツールのコンボボックスを大量に作ろうと考えています。 以前にコントロールツールで作ったのですが結構重い為、今回フォームツールで作成したいのです。 その際、ドロップダウンリストの行を増やすにはどうしたらいいでしょうか? コントロールツールの時は下記コードで Object.ListRows = 20 で増やすことができたのですが、フォームツールの場合サポートしていませんとでます。 VBAで行を増やす事はできないでしょうか? 素人質問ですみません。 Sub Sheet1() Dim sh As Worksheet Set sh = Worksheets("Sheet1") For i = 1 To 100 l = sh.Cells(i, "E").Left t = sh.Cells(i, "E").Top w = sh.Cells(i, "E").Width h = sh.Cells(i, "E").Height With sh.OLEObjects.Add(ClassType:="Forms.ComboBox.1") .Left = l .Top = t .Width = w .Height = h .ListFillRange = "担当者" .Object.ListRows = 20 .LinkedCell = "E" & i .PrintObject = False End With Next i End Sub

みんなの回答

  • watabe007
  • ベストアンサー率62% (476/760)
回答No.2

>For i = 1 To 3 ↓ For i = 1 To 100 >Set sh = Nothing   ↑   不用

  • watabe007
  • ベストアンサー率62% (476/760)
回答No.1

>今回フォームツールで作成したいのです。 参考に Sub Test()   Dim objDrop As DropDown   Dim i As Long   With Worksheets("Sheet1")     For i = 1 To 3       Set objDrop = .DropDowns.Add( _         Left:=.Cells(i, "E").Left, _         Top:=.Cells(i, "E").Top, _         Width:=.Cells(i, "E").Width, _         Height:=.Cells(i, "E").Height)       objDrop.ListFillRange = "担当者"       objDrop.LinkedCell = "E" & i       objDrop.DropDownLines = 20       objDrop.Display3DShading = False     Next   End With   Set sh = Nothing   Set objDrop = Nothing End Sub

関連するQ&A

  • ドロップダウンリストの行を増やしたいです。VBA。

    エクセル2000。VBAでコンボボックスを作成したのですが、ドロップダウンリストの表示する行の増やし方が分かりません。” 担当者”は20セル(人)指定しています。 プロパティからならListRowsを8から変更すればいいだけなので分かります。ですがVBAで実施したいです。ドロップダウンリスト表示を20に増やすにはどうしたらいいでしょうか?かなり困っていますのでどうぞ宜しくお願いします。 Selection.ListRows = 20 を足したところ、実行時エラー438「オブジェクトは、このプロパティまたはメソッドをサポートしていません。」となりました。 Sub test() Dim sh As Worksheet Set sh = Worksheets("Sheet1") For i = 1 To 100 l = sh.Cells(i, "H").Left t = sh.Cells(i, "H").Top w = sh.Cells(i, "H").Width h = sh.Cells(i, "H").Height sh.OLEObjects.Add(ClassType:="Forms.ComboBox.1", _ Left:=l, Top:=t, Width:=w, Height:=h _ ).Select Selection.ListFillRange = "担当者" Selection.LinkedCell = "H" & i Selection.PrintObject = False Next i End Sub

  • エクセルマクロでチェックボックスを作成する方法

    下記の方法でExcel起動時にE1~E50にチェックボックスを 作成しています。 (F列にはチェックの結果を表示させています) Sub Auto_open() Dim i As Integer Dim cbx As CheckBox With Selection.Parent For i = 1 To 50 Set cbx = .CheckBoxes.Add(Left:=Cells(i, 5).Left, _ Top:=Cells(i, 5).Top, _ Height:=Cells(i, 5).Height, _ Width:=Cells(i, 5).Width) cbx.Text = "" cbx.LinkedCell = "F" & i cbx.Display3DShading = True Next i End With Set cbx = Nothing End Sub チェックボックスにチェックされたら チェックされた行のA~Dの色を変更したいのですが、 どのようにやるのか分からなく困っています。 (チェックボックスのクリックイベントを50個つくるわけにも いかないですし・・・) 何か少しでもアイデア等ございましたら ご教授お願いします。

  • コンボボックスの開いたリストを閉じるには

    コンボボックスのリストを開くのはComboBox1.DropDownでできますが、閉じるのはどういう風にやればいいでしょうか。 今ユーザーフォームで Private Sub Combobox1_Change() ComboBox1.Clear v = ComboBox1.Text For i = 1 To 300 c = Worksheets("Sheet1").Cells(i, "A") If v = Left(c, Len(v)) And Len(v) > 0 Then ComboBox1.AddItem c End If Next i ComboBox1.DropDown End Sub と言う風にしていますが、リストを開きっぱなしだと変な表示になってしまい、マウスクリックで一旦閉じてから開かないと変な表示になってしまうのです。 そこで一旦リストをマクロで閉じさせてから再び開きたいのですが、どうすればいいでしょうか。

  • Excelのワークシートでのコンボボックスについて

    Excelのワークシートでコンボボックスを設定する方法を教えてください。 「フォームコントロール」と「ActiveXコントロール」の違いがわかりません。 添付の画像の通りコンボボックスに西暦を入力(別シートに入力済みの値を表示するように設定)してあるのですが、ファイルを保存しているにも関わらず、再度ファイルを開くとコンボボックスの中のリストは空欄になってしまいます。 今は「ActiveXコントロール」のコンボボックスで設定しています。 コードは以下のように設定してみたのですが、設定内容や設定箇所が違うのでしょうか? ////////////////////////////////////////////////////// Private Sub ComboBox1_DropButtonClick() Dim sh As Worksheet Set sh = Worksheets("マクロ") Dim i As Integer Dim lastRow As Integer lastRow = sh.Cells(Rows.Count, 1).End(xlUp).Row With ComboBox1 For i = 2 To lastRow If ComboBox1 = "" Then .AddItem sh.Cells(i, 1).Value End If Next i End With End Sub ////////////////////////////////////////////////////// コンボボックスのリストの内容が消えてしまうので、 コードの内容は同じで以下のところにもコードを書いてみました。 ////////////////////////////////////////////////////// Private Sub Worksheet_Activate() Dim sh As Worksheet Set sh = Worksheets("マクロ") Dim i As Integer Dim lastRow As Integer lastRow = sh.Cells(Rows.Count, 1).End(xlUp).Row With ComboBox1 For i = 2 To lastRow If ComboBox1 = "" Then .AddItem sh.Cells(i, 1).Value End If Next i End With End Sub ////////////////////////////////////////////////////// なんだかもう、訳がわからずぐちゃぐちゃです。 コンボボックスの中に値が入っていると、実行ボタンをクリックしたときは正常にやりたい結果を出すことが実現できます。 ファイルを閉じた後に再度開いてもコンボボックスの中に値があるようにするにはどうしたらよいのか、ド素人の私にご教授いただきたくお願いいたします。

  • 同じコンボボックス、リストボックスを使うには?

    よろしくお願いします。 今、ユーザーフォームを使って製造計画表を作っています。 コンボボックスで会社名、リストボックスで会社ごとの製品名を選択させるとこまで出来ました。 1日に3つの製品を作ることが出来るので、同じ中身のコンボボックス、リストボックスを使って3つ作りたいと思っています。 ユーザーフォームの形的にはこのような感じですが。 1. コンボボックス  リストボックス 2. コンボボックス  リストボックス 3. コンボボックス  リストボックス 今は、1.のとこだけは出来たのですが、2.3.は1.と同じコードをコピーして必要と思われるとこだけをコンボボックス2と変えたりしてみたのですが、上手くいきませんでした。こんなコードですが。 Private Sub UserForm_initialize() 'ComboBox1セット Dim ico As Long ico = 1 With ThisWorkbook.Worksheets("Sheet1") Do While .Cells(1, ico) <> "" Me.ComboBox1.AddItem .Cells(1, ico).Value ico = ico + 1 Loop End With Me.ComboBox1.SetFocus End Sub Private Sub ComboBox1_Change() 'ListBox1セット Dim ico As Long 'Me.ListBox1.Clear ico = Me.ComboBox1.ListIndex + 1 With ThisWorkbook.Worksheets("Sheet1") Me.ListBox1.List = .Range(.Cells(2, ico), _ .Cells(.Cells(Rows.Count, ico).End(xlUp).Row, ico)).Value End With End Sub VBAも初めたばかりで質問の内容もわかりづらいとも思いますが、よろしくお願いします。

  • ExcelVBAでコンボボックスに初期値設定

    ExcelVBAでユーザーフォームを作成しています。 表示したときにコンボボックスに「選択して下さい」と表示させる方法を教えて下さい。 コンボボックスで「2003年_H15」~「2012年_H24」が選択できて、選択するとラベルに「2002~2004年」のように表示されます。 【コンボボックス:選択】2003年_H15 【ラベル:表示】2002~2004年 コンボボックスの値はSheetから設定しています。 ユーザーフォームを表示させたときにコンボボックスに「選択して下さい」と初期値として設定するにはどうしたらよいか教えて下さい。 Sheetに追加するとかんたんなのですが、ラベルに表示させるために、以下のようなコードを書いていたりするので、うまく動きません。 Private Sub ComboBox_Change() Dim sh As Worksheet Set sh = Worksheets("Sheet1") With ComboBox If .ListIndex >= 0 Then Label.Caption = Left(sh.Cells(.ListIndex + 1, 1), 4) _ & "~" & Left(sh.Cells(.ListIndex + 3, 1), 4) & "年" End If End With End Sub よろしくお願い致します。

  • (VBA)スピンボタンの大量コピー(相対参照)

    お世話になります。質問させていただきます。 表題件ですが、EXCELにて 「A列にコントロールツールの"スピンボタン"をリンクセルを相対参照にして縦に大量にコピー(さらに増減値をデフォルトの1から10に変更)」したいと考えています。 以下に記載したVBAコードは、こちらと同様のQ&Aサイトにて見つけてきた「A列にコントロールツールの"チェックボックス"をリンクセルを相対参照にして縦に大量にコピー」するコードです。 先ずは参考までにご確認ください。 ----------------------------------------------------------------- Sub Checkbox連続作成() Dim myChk As Object Dim i As Long Dim Sakuseisuu As Long Dim StartCell As Range '--------↓ここを変更--------- Sakuseisuu = 20 'チェックボックスの作成数 Set StartCell = Range("A1") 'スタートする位置 '--------↑ここを変更--------- For i = 0 To Sakuseisuu - 1 With StartCell.Offset(i) Set myChk = ActiveSheet _ .OLEObjects.Add(classtype:="Forms.CheckBox.1", _ Link:=False, DisplayAsIcon:=False, _ Left:=.Left, Top:=.Top, _ Width:=.Width, Height:=.Height) End With With myChk .LinkedCell = StartCell.Offset(i, 1).Address .Object.Caption = "" .Object.Value = False End With Next End Sub ------------------------------------------------------------------ 上記コードを参考に、「A列にコントロールツールの"スピンボタン"をリンクセルを相対参照にして縦に大量にコピー」すべく、コードを以下のように短絡的に書き換えてみましたが、エラーとなってしまいます。 ------------------------------------------------------------------ Sub SpinButton連続作成() Dim myspin As Object Dim i As Long Dim Sakuseisuu As Long Dim StartCell As Range '--------↓ここを変更--------- Sakuseisuu = 20 'チェックボックスの作成数 Set StartCell = Range("A1") 'スタートする位置 '--------↑ここを変更--------- For i = 0 To Sakuseisuu - 1 With StartCell.Offset(i) Set myspin = ActiveSheet _ .OLEObjects.Add(classtype:="Forms.SpinButton1.", _ Link:=False, DisplayAsIcon:=False, _ Left:=.Left, Top:=.Top, _ Width:=.Width, Height:=.Height) End With With myspin .LinkedCell = StartCell.Offset(i).Address .Object.Caption = "" .Object.Value = False End With Next End Sub ------------------------------------------------------------------ お詳しいかたがおられましたら、是非ともアドバイスを頂戴したく存じます。 さらにわがままを述べると、増減値をデフォルトの1から10に変更したく考えております。 何卒よろしくお願い申し上げます。

  • EXCELのVBAで画像ファイルを呼び出し

    EXCELのVBAでセルに入力されているファイル名の画像ファイルを呼び出して、 トリミング、縮小→一旦切り取り、メタファイルで貼り付け→セルの真ん中に配置ということを行いたいです。 このようなVBAを組みましたが、bw = .Width でエラーが起こってしまいます。 一旦切り取りして貼り付けするコードを加えたらエラーになりました。 どのようにしたらきちんと希望の形ではりつけることができるでしょうか? よろしくお願いします。 Sub photocalltest() 'セルの値を取得して画像を貼り付け ' ' Dim i As Long For i = 2 To 5 ActiveSheet.Pictures.Insert ("C:\Documents and Settings\temp\" & Cells(7, i).Value & ".jpg") With ActiveSheet.Shapes(ActiveSheet.Shapes.Count) 'トリミング .PictureFormat.CropBottom = 95 .PictureFormat.CropRight = 57.78 .PictureFormat.CropLeft = 59.28 .PictureFormat.CropTop = 100 '縮小 .Height = 197.25 .Width = 162# .Cut 'Cells(7, i).Select ActiveSheet.PasteSpecial Format:="図 (拡張メタファイル)" '貼り付け位置指定 aw = Cells(7, i).Width bw = .Width //ここでオブジェクトが必要ですエラー x = (aw - bw) / 2 .Left = Cells(7, i).Left + x ah = Cells(7, i).Height bh = .Height y = (ah - bh) / 2 .Top = Cells(7, i).Top + y End With Next i End Sub

  • ご教授ください。

    こんにちは。 MS Office (Excel)で、下記のソースがネット上で公開されていたのですが、細かいコマンドの意味がわからないので、解説頂けないでしょうか? <以下がソースです> Sub コンボボックス作成() Dim i As Integer For i = 1 To 20 Cells(i, 1) = "リスト" & i Next ActiveSheet.OLEObjects.Add(ClassType:="Forms.ComboBox.1", Link:=False, _ DisplayAsIcon:=False, Left:=Cells(1, 4).Left, Top:=0, _ Width:=120, Height:=24).Select With Selection .ListFillRange = "A1:A20" .Object.ListRows = 20 .Object.Font.Size = 32 End With Application.CommandBars("Control Toolbox").Visible = False Range("C1").Select End Sub 出来れば1行ずつ解説頂けるとありがたいです。 宜しくお願い致します。

  • 図形消去後に文字入力(エクセル)

    Sub test()  Dim c As Range  If Not TypeName(Selection) = "Range" Then Exit Sub      For Each c In Selection    With c.MergeArea     wTop = .Top     wLeft = .Left     wBottom = .Top + .Height     wRight = .Left + .Width    End With   For Each s In ActiveSheet.DrawingObjects   With s    If wTop <= .Top And _      wLeft <= .Left And _      wBottom >= .Top + .Height And _      wRight >= .Left + .Width Then      .Delete    End If   End With   Next   Next End Sub 上記マクロは、選択状態になっている個々のセルの中に、すっぽり収まる状態で存在しているオブジェクトを消去します。 オブジェクトが消去されたセルに、"○"が入力されるようにしたいのですが。 どういった記述が必要になるでしょうか?

専門家に質問してみよう