Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


8132 / 76732 ←次へ | 前へ→

【74177】Re:ドロップボックスリストの自動表示についてい
発言  UO3  - 13/4/26(金) 13:42 -

引用なし
パスワード
   ▼ぶんぶん さん:

要件がよく呑み込めていません。
ところで、もしかして大きな勘違いをしていたかもしれません。
ドロップボックスというのは入力規則のリスト型だと思っていたのですが
そうではなく、フォームツール等のコンボボックスのことでしたか?

もし、入力規則のことでしたら、たたき台として新規ブックのSheet1に
選択その1 〜 選択その4 まで定義し、それぞれに入力規則のリストを設定したうえで
ThisWorkbookモジュールに以下を貼り付け、いったん保存して閉じてから
もう一度、開いてみてください。

こんな動きなんでしょうか?

Option Explicit

Const shn As String = "Sheet1" '対象シート名

Private Sub Workbook_Open()
  If ActiveSheet Is Sheets(shn) Then ListShow ActiveSheet.Range("選択その1")
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
  If Sh Is Sheets(shn) Then ListShow Sh.Range("選択その1")
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
  If Not Sh Is Sheets(shn) Then Exit Sub
  
  Select Case Target.Address
    Case Sh.Range("選択その1").Address
      ListShow Sh.Range("選択その2")
    Case Sh.Range("選択その2").Address
      ListShow Sh.Range("選択その3")
    Case Sh.Range("選択その3").Address
      ListShow Sh.Range("選択その4")
    Case Sh.Range("選択その4").Address
      ListShow Sh.Range("選択その1")
  End Select
End Sub

Private Sub ListShow(r As Range)
  SendKeys "%{Down}"
  r.Activate
End Sub

0 hits

【74162】ドロップボックスリストの自動表示についてい ぶんぶん 13/4/22(月) 18:04 質問
【74163】Re:ドロップボックスリストの自動表示につ... UO3 13/4/23(火) 7:05 発言
【74164】Re:ドロップボックスリストの自動表示につ... UO3 13/4/23(火) 9:31 発言
【74168】Re:ドロップボックスリストの自動表示につ... ぶんぶん 13/4/23(火) 13:40 発言
【74169】Re:ドロップボックスリストの自動表示につ... UO3 13/4/23(火) 14:31 発言
【74173】Re:ドロップボックスリストの自動表示につ... ぶんぶん 13/4/26(金) 9:23 発言
【74174】Re:ドロップボックスリストの自動表示につ... UO3 13/4/26(金) 11:41 発言
【74176】Re:ドロップボックスリストの自動表示につ... ぶんぶん 13/4/26(金) 13:14 発言
【74177】Re:ドロップボックスリストの自動表示につ... UO3 13/4/26(金) 13:42 発言
【74179】Re:ドロップボックスリストの自動表示につ... ぶんぶん 13/4/26(金) 18:42 発言
【74180】Re:ドロップボックスリストの自動表示につ... UO3 13/4/26(金) 20:19 発言
【74181】Re:ドロップボックスリストの自動表示につ... UO3 13/4/26(金) 20:25 発言
【74182】Re:ドロップボックスリストの自動表示につ... ぶんぶん 13/4/26(金) 20:51 お礼

8132 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free