こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

締切り済みの質問

コンボボックスの貼りつけ excel

vba初心者です。excel帳簿を作っております。
科目選択時にリストが28個あるプルダウンを使っておりましたが選択するのが大変だったのでコンボボックスにしたら28個全て表示されるようになり選択が楽になりました。

このコンボボックスのLinkedCellはD4です。
コンボボックスをD4の上に表示してD4セルにピッタリはめ込んでいる感じに見えます。

D4以下150個、D列にコンボボックスを貼りつけたいです。

コピーして貼り付けてもLinkedCellはD4のままですので、貼りつけたコンボボックスのプロパティを150回変えないといけないのかと思うと気が遠くなります。

このコンボボックスを何か登録して、「コードの表示」あたりで何かやれば何とかなるのではないかと思ったのですが、何か手立てがあれば教えてください。

このコンボボックスを同じブックの別のシートにも使いたいと思っております。

投稿日時 - 2019-09-02 04:44:12

QNo.9652236

困ってます

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(4)

ANo.4

D5セルから新たに150個のコンボボックスを追加しました。
Sub Test()
  Dim c As Range
  For Each c In Range("D5:D154")
    With ActiveSheet.OLEObjects.Add(ClassType:="Forms.ComboBox.1")
      .Left = c.Left
      .Top = c.Top
      .Width = c.Width
      .Height = c.Height
      .ListFillRange = "Sheet2!A2:A29" 'リスト範囲を設定
      .LinkedCell = c.Address 'リンクセル
    End With
  Next
End Sub

投稿日時 - 2019-09-02 13:37:17

ANo.3

もし、ちらちらするのが気になるようでしたら
以下のようにApplication.ScreenUpdatingをいれると解消されると思いますが、常時実行するものでもないと思いますので、ちらちらしたほうが動いてる感じがわかっていいかもしれません。
Sub Test2()
Dim i As Long
Dim mCombo As ComboBox
Application.ScreenUpdating = False
For i = 5 To 8
ActiveSheet.Shapes.Range(Array("ComboBox1")).Select
Selection.Copy
Cells(i, "D").Select
ActiveSheet.Paste
Set mCombo = ActiveSheet.OLEObjects(Selection.ShapeRange.Name).Object
mCombo.Top = Cells(i, "D").Top
mCombo.Left = Cells(i, "D").Left
mCombo.LinkedCell = "D" & i
Set mCombo = Nothing
Next
Application.ScreenUpdating = True
End Sub

投稿日時 - 2019-09-02 10:03:10

ANo.2

No1の補足です。
テストでできたコンボボックスは実際に実行する前に削除してください。削除しないと、実際に実行した場合同じものが重なって作成されます。

投稿日時 - 2019-09-02 08:53:40

ANo.1

これでいけると思います。一応D5からD8までにしてますのでうまくいけば実際の行数まで増やしてください。ComboBox1は実際のコンボボックス名にしてください。
Sub Test()
Dim i As Long
Dim mCombo As ComboBox
For i = 5 To 8
ActiveSheet.Shapes.Range(Array("ComboBox1")).Select
Selection.Copy
Cells(i, "D").Select
ActiveSheet.Paste
ActiveSheet.Shapes(Selection.ShapeRange.Name).Top = Cells(i, "D").Top
ActiveSheet.Shapes(Selection.ShapeRange.Name).Left = Cells(i, "D").Left
Set mCombo = ActiveSheet.OLEObjects(Selection.ShapeRange.Name).Object
mCombo.LinkedCell = "D" & i
Set mCombo = Nothing
Next
End Sub

投稿日時 - 2019-09-02 08:49:45

あなたにオススメの質問