Excel VBA質問箱 IV

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

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


9372 / 13646 ツリー ←次へ | 前へ→

【27696】コンボボックを使いたい zondag 05/8/16(火) 16:57 質問[未読]
【27698】Re:コンボボックを使いたい Kein 05/8/16(火) 17:24 回答[未読]
【27700】Re:コンボボックを使いたい zondag 05/8/16(火) 17:51 質問[未読]
【27702】Re:コンボボックを使いたい Kein 05/8/16(火) 19:31 回答[未読]
【27726】Re:コンボボックを使いたい zondag 05/8/17(水) 10:37 質問[未読]
【27729】Re:コンボボックを使いたい Kein 05/8/17(水) 12:46 発言[未読]
【27730】Re:コンボボックを使いたい zondag 05/8/17(水) 13:04 発言[未読]
【27731】Re:コンボボックを使いたい Kein 05/8/17(水) 13:13 発言[未読]
【27734】Re:コンボボックを使いたい zondag 05/8/17(水) 13:41 質問[未読]
【27743】Re:コンボボックを使いたい Kein 05/8/17(水) 17:21 回答[未読]
【27769】Re:コンボボックを使いたい zondag 05/8/18(木) 17:55 お礼[未読]

【27696】コンボボックを使いたい
質問  zondag  - 05/8/16(火) 16:57 -

引用なし
パスワード
   コンボボックスの使い方が全然わかりません
コンボボックスのリストを1,2,3として
近くに設置したボタンを押すと
1ならAというプログラムを実行し、2ならB、3ならC
のようにできるようにしたいです
宜しくお願いします

【27698】Re:コンボボックを使いたい
回答  Kein  - 05/8/16(火) 17:24 -

引用なし
パスワード
   コンボボックスには、フォームツールバーのものとコントロールツールボックスのもの
があります。ユーザーフォームに配置するなら後者に限られますが、シート上に配置
するならどちらでも選択できます。ただその場合、フォームツールバーのの方は
エクセルに組み込まれたコントロールなので、安定性の点でActiveXより優れている
ようです。よって「任意のセルをダブルクリックしたら、その位置へフォーム
ツールバーのコンボボックスを配置し、1,2,3 というリストを選択した瞬間に
それぞれの処理を行うマクロを起動する」という形を提示してみます。

↓シートモジュールに入れます。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _
Cancel As Boolean)
  Dim Lp As Single, Tp As Single
  Dim Wp As Single, Hp As Single
  Dim i As Integer

  Cancel = True
  ActiveSheet.DropDowns.Delete
  With Target
   Lp = .Left: Tp = .Top
   Wp = .Width: Hp = .Height
  End With
  With ActiveSheet.DropDowns.Add(Lp, Tp, Wp, Hp)
   For i = 1 To 3
     .AddItem "処理 " & i
   Next i
   .OnAction = "SetMacro"
  End With
End Sub

↓標準モジュールに入れます。

Sub SetMacro()
  Dim x As Variant

  x = Application.Caller
  If VarType(x) <> 8 Then Exit Sub
  With ActiveSheet.DropDowns(x)
   Select Case .ListIndex
     Case 1: Call A
     Case 2: Call B
     Case 3: Call C
   End Select
   .Delete
  End With
End Sub

Sub A()
  ここに A の処理を書く
End Sub

Sub B()
  ここに B の処理を書く
End Sub

Sub C()
  ここに C の処理を書く
End Sub

【27700】Re:コンボボックを使いたい
質問  zondag  - 05/8/16(火) 17:51 -

引用なし
パスワード
   ▼Kein さん:
動きました、ありがとうございます。

私の言葉足らずのようで
数字の1,2,3は○○をするみたいな感じの文字が入るようにしたいです
あとコンボボックスはA1セルに固定したいです
わがままですみません
よろしくお願いします

【27702】Re:コンボボックを使いたい
回答  Kein  - 05/8/16(火) 19:31 -

引用なし
パスワード
   ならば、こんな感じです。シートモジュールに入れたダブルクリックイベントは削除し、
新たに・・

↓シートモジュールに入れます。

Private Sub Worksheet_Activate()
  Dim Wp As Single, Hp As Single
 
  ActiveSheet.DropDowns.Delete
  With Range("A1")
   Wp = .Width * 2: Hp = .Height
  End With
  With ActiveSheet.DropDowns.Add(0, 0, Wp, Hp)
   .AddItem "○○をする"
   .AddItem "△△をする"
   .AddItem "××をする"
   .OnAction = "SetMacro"
  End With
End Sub

Private Sub Worksheet_Deactivate()
  Worksheets("Sheet1").DropDowns.Delete
  '↑シート名は正確なものに変更
End Sub

↓標準モジュールに入れます。

Sub SetMacro()
  Dim x As Variant

  x = Application.Caller
  If VarType(x) <> 8 Then Exit Sub
  With ActiveSheet.DropDowns(x)
   Select Case .ListIndex
     Case 1: Call A
     Case 2: Call B
     Case 3: Call C
   End Select
  End With
End Sub

Sub A()
  ここに A の処理を書く(○○の場合です)
End Sub

Sub B()
  ここに B の処理を書く(△△の場合です)
End Sub

Sub C()
  ここに C の処理を書く(××の場合です)
End Sub

* 変更点は、DoropDown(フォームのコンボボックスのこと)を
Delete するコードを消すだけです。

【27726】Re:コンボボックを使いたい
質問  zondag  - 05/8/17(水) 10:37 -

引用なし
パスワード
   ▼Kein さん:
ありがとうございます
かなり思い通りの構成になって助かっています

しかし、不具合がでてきました
今まで使えていたActiveSheet.Pasteがデバックに引っかかってしまいます。
どこを直せばよろしいでしょうか
宜しくお願いします

【27729】Re:コンボボックを使いたい
発言  Kein  - 05/8/17(水) 12:46 -

引用なし
パスワード
   >今まで使えていたActiveSheet.Paste
とは、何のことでしょーか ? 私はそのようなコードを提示した覚えがありませんが。

【27730】Re:コンボボックを使いたい
発言  zondag  - 05/8/17(水) 13:04 -

引用なし
パスワード
   ▼Kein さん:
>>今まで使えていたActiveSheet.Paste
>とは、何のことでしょーか ? 私はそのようなコードを提示した覚えがありませんが。

コンボボックスで選んだ後に行うプログラムの中に書いてあります

【27731】Re:コンボボックを使いたい
発言  Kein  - 05/8/17(水) 13:13 -

引用なし
パスワード
   では、そのコードをプロシージャごと提示してみて下さい。こちらで検証可能なら
検証してみますが・・・。

【27734】Re:コンボボックを使いたい
質問  zondag  - 05/8/17(水) 13:41 -

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

下記のようなプログラムを使ってます
Sheet1の選択した行のA列のセルをSheet2にコピーする
宜しくお願いします
------------------
Sub コピー()

Dim act As Variant
Dim act2 As Variant

Worksheets("Sheet1").Select

Application.ScreenUpdating = Flase


act = ActiveCell.Address
Range(act).EntireRow.Select
act2 = Application.Intersect(Selection, Range("A:A")).Value

MsgBox act2 & "をコピーします"


  Sheets("Sheet1").Select
  Range(act).EntireRow.Select
  Application.Intersect(Selection, Range("A:A")).Select
  Application.CutCopyMode = False
  Selection.Copy
  Sheets("Sheet2").Select
  Range("A1").Select
  ActiveSheet.Paste

  
End Sub

【27743】Re:コンボボックを使いたい
回答  Kein  - 05/8/17(水) 17:21 -

引用なし
パスワード
   んー・・コンボボックスを配置している A1 セルが Sheet1 なのか Sheet2 なのか
分かりませんが、いずれにせよそこから値をコピーする又は貼り付ける、という処理が
うまくいかない、というわけではないようですよ。
で、そのコードを整理・編集してみると

Sub コピー()
  Dim x As Long

  Sheets("Sheet1").Activate
  x = ActiveCell.Row
  Cells(x, 1).Copy Sheets("Sheet2").Range("A1")
End Sub

ぐらいで出来るはずですから、これで試してみて下さい。

【27769】Re:コンボボックを使いたい
お礼  zondag  - 05/8/18(木) 17:55 -

引用なし
パスワード
   問題なく動作しています。
長い間お付き合いありがとうございました。
これからも何かありましたらお力をお貸してください。

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