Excel VBA質問箱 IV

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

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


8013 / 13645 ツリー ←次へ | 前へ→

【35484】マクロボタンの 登録マクロ切り替え 下働き 06/3/6(月) 17:16 質問[未読]
【35493】Re:マクロボタンの 登録マクロ切り替え Ned 06/3/6(月) 20:40 発言[未読]
【35502】Re:マクロボタンの 登録マクロ切り替え ponpon 06/3/7(火) 0:09 発言[未読]
【35513】Re:マクロボタンの 登録マクロ切り替え 下働き 06/3/7(火) 10:08 質問[未読]
【35536】Re:マクロボタンの 登録マクロ切り替え Kein 06/3/7(火) 14:40 回答[未読]
【35545】Re:マクロボタンの 登録マクロ切り替え 下働き 06/3/7(火) 15:48 質問[未読]
【35551】Re:マクロボタンの 登録マクロ切り替え Kein 06/3/7(火) 16:07 発言[未読]

【35484】マクロボタンの 登録マクロ切り替え
質問  下働き  - 06/3/6(月) 17:16 -

引用なし
パスワード
   以前【34975】にて質問させていただいた下働きです。
内容は異なるのですが、同じツール作成について質問させて頂きます。

マクロボタンによる作図ツールを作成しているのですが良くわからないところがあるのでお教えください。
先ず下記のように複数の作図及び消去マクロを作成しました。これをマクロボタンに登録して作図ツールとしようと思うのですが、数が多くなり紛らわしくなります。またマクロを使う場所が2種類(セルを赤:道具系と青:コネクタ系に塗り分けています)ありますので、押し間違いをなくしたいと思っています。
そこで、ActiveCellが赤だったら道具系マクロを登録、青だったらコネクタ系マクロを登録、それ以外だったら登録しないとしたいのですが、良い方法を教えてください。
マクロの記録でマクロボタンの登録動作を調べましたがマクロ番号が順次変わってしまってうまくいきません。よろしくお願いいたします。
例)
  A  B   C    D    E    F
1   [マクロボタン1]    [マクロボタン2] ←ActiveCellの色により
2                        ボタン名称、機能を
3   [ 赤 ]    [ 青 ]      [ 赤 ]   切り替えたい。
4
5
6
7   [ 赤 ]    [ 青 ]      [ 青 ]
8

Sub model_11()
 ' モデリング 道具追加
    ActiveSheet.Range("AK3:AN4").Copy
    ActiveCell.Offset(3, -1).Range("A1").Select
    ActiveSheet.Paste
    ActiveCell.Offset(1, 0).Range("A1").Value = 0
    ActiveCell.Range("A1:D1").Value = ""
  
    ActiveCell.Select
End Sub

Sub model_42()
' モデリング コネクタ消去
    ActiveCell.Offset(1, 0).Range("A1:A5").Borders _                 (xlEdgeRight).LineStyle = xlNone
End Sub


−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−
ちなみに前回の質問については下記内容で一応動作しました。
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  With Target
    If .Column < 255 Then
      If [a1].Value <> "" Then
        [a1].Value = [a1].Value * (-1)
      Else
        [a1].Value = 1
      End If
    Else: [a1].Value = ""
    End If 'ifを入れなくても良さそう※要再検証
  End With
End Sub

Function R_XXX_test(YOKO As Variant, XXX_P As Variant, _
      XXX_XX As Double, リフレッシュ As Variant)
'リフレッシュにA1を取り込みセル移動で毎回計算させる
'罫線情報取得テスト
  Dim shoukei, YOKO_XX
  
  If YOKO.Value = "" Then YOKO_XX = 0 Else YOKO_XX = YOKO.Value
    
  shoukei = 0
  If KIKI_P.Borders(xlEdgeRight).LineStyle <> xlNone Then
         shoukei = shoukei + XXX_XX
  If YOKO.Borders(xlEdgeBottom).LineStyle <> xlNone Then
         shoukei = shoukei + YOKO_XX
  If shoukei = 0 Then R_XXX_test = "" Else _
         R_XXX_test = shoukei
End Function

【35493】Re:マクロボタンの 登録マクロ切り替え
発言  Ned  - 06/3/6(月) 20:40 -

引用なし
パスワード
   こんにちは。
ボタンにマクロを登録するのは、いつのタイミングで、どうやって登録しますか?

ボタンを押した時のアクティブセルの色によって、
Callするマクロを分岐させたらどうですか?同じ事のような?^ ^;

【35502】Re:マクロボタンの 登録マクロ切り替え
発言  ponpon  - 06/3/7(火) 0:09 -

引用なし
パスワード
   >ボタンを押した時のアクティブセルの色によって、
>Callするマクロを分岐させたらどうですか?同じ事のような?^ ^;


こんなことかな? はずしたかな?
シートモジュールに。
ボタンは、コントロールツールボックスのものです。

Private Sub CommandButton1_Click()
  Select Case ActiveCell.Interior.ColorIndex
    Case 3
    Me.CommandButton1.Caption = "赤"
    MsgBox "赤" 'Call マクロ1
    Case 5
    Me.CommandButton1.Caption = "青"
    MsgBox "青" 'Call マクロ2
  End Select
End Sub

【35513】Re:マクロボタンの 登録マクロ切り替え
質問  下働き  - 06/3/7(火) 10:08 -

引用なし
パスワード
   ご回答、ありがとうございます。
頂いた内容ですと、ボタンクリックに対して内容の入れ替えが起きるので意図しているものと違うようです。応用すればよいのでしょうから検討してみます。
あれから自分で作成したものを以下に示します。マクロの切り替えはこれで出来るのですが、マクロ実動作の際に問題がおきますのでご助言お願いします。
(1)、(2)の2箇所あるのですが、ともに[Select]を使っているために問題があるようです。(Selectの際にマクロ切替作業が入るため?)ただし下記の記述ではうまくいかなかったのでSelectを利用しています。

(1) OK ActiveSheet.Shapes("Button 8").OnAction = "model_11"
   駄目 ActiveSheet.Shapes("Button 8").Characters.Text = "道具L字追加

(2) ActiveSheet.Range("AK3:AN4").Copy
   ActiveCell.Offset(3, -1).Range("A1").Paste 駄目

また、野暮ったいリストなので動作も重いものとなっているようです、もっと効率的な手法がありましたら、併せてご回答をお願いいたします。
−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

  With Target
    If .Interior.ColorIndex = 35 Then
      ActiveSheet.Shapes("Button 8").Select
        Selection.OnAction = "model_11"
        Selection.Characters.Text = "道具L字追加"◆※(1)※◆
      ActiveSheet.Shapes("Button 9").Select
        Selection.OnAction = "model_12"
        Selection.Characters.Text = "道具T字追加"
        
    ElseIf .Interior.ColorIndex = 24 Then
      ActiveSheet.Shapes("Button 8").Select
        Selection.OnAction = "model_31"
        Selection.Characters.Text = "コネクタ横伸長"
      ActiveSheet.Shapes("Button 9").Select
        Selection.OnAction = "model_32"
        Selection.Characters.Text = "コネクタ縦伸長"
    Else
      ActiveSheet.Shapes("Button 8").Select
        Selection.OnAction = ""
        Selection.Characters.Text = ""
      ActiveSheet.Shapes("Button 9").Select
        Selection.OnAction = ""
        Selection.Characters.Text = ""
    End If
  End With
  ActiveCell.Select
  [a1].Value = ""
End Sub
−−−−−−−−−−−−−−−−−−−−−−−−−−
Sub model_11()
' モデリング道具L字追加
    ActiveCell.Offset(0, 1).Range("A1:C1") _
      .Borders(xlEdgeBottom).LineStyle = xlNone
  With ActiveCell.Offset(0, -2).Range("A1:c1").Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
  End With
  With ActiveCell.Offset(1, 0).Range("A1:A2").Borders(xlEdgeRight)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
  End With
    ActiveSheet.Range("AK3:AN4").Copy
    ActiveCell.Offset(3, -1).Range("A1").Select"◆※(2)※◆
    ActiveSheet.Paste
    ActiveCell.Offset(1, 0).Range("A1").Value = 0
    ActiveCell.Range("A1:D1").Value = ""
  
    ActiveCell.Select
End Sub

【35536】Re:マクロボタンの 登録マクロ切り替え
回答  Kein  - 06/3/7(火) 14:40 -

引用なし
パスワード
   セル選択イベントだと、ちょっと頻繁に発生しすぎるので、適切ではないように
思います。私なら右クリックイベントに変えて

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, _
Cancel As Boolean)
  Dim AcPro1 As String, AcPro2 As String
  Dim Cap1 As String, Cap2 As String

  Cancel = True
  Select Case Target.Interior.ColorIndex
    Case 24
     AcPro1 = "model_11": AcPro2 = "model_12"
     Cap1 = "道具L字追加": Cap2 = "道具T字追加"
    Case 35
     AcPro1 = "model_31": AcPro2 = "model_32"
     Cap1 = "コネクタ横伸長": Cap2 = "コネクタ縦伸長"
    Case Else
     AcPro1 = "": AcPro2 = ""
     Cap1 = "": Cap2 = ""
  End Select
  With ActiveSheet.Shapes("Button 8")
    .OnAction = AcPro1: .Characters.Text = Cap1
  End With
  With ActiveSheet.Shapes("Button 9")
    .OnAction = AcPro2: .Characters.Text = Cap2
  End With
End Sub

【35545】Re:マクロボタンの 登録マクロ切り替え
質問  下働き  - 06/3/7(火) 15:48 -

引用なし
パスワード
   Kein さん 回答ありがとうございます。
UPしていただいた内容で動作確認いたしましたが、2回目の質問の(1)でも書いておりますが、やはり
>  .OnAction = AcPro1: .Characters.Text = Cap1
でエラーになります。  ~~~~~~~~~~~~~~~~~~~~~~~~~~
ちなみに使用している環境は、WinXP Excel2000(SP3)です。
図々しいとは思いますが、対処法をお教え願います。

>セル選択イベントだと、ちょっと頻繁に発生しすぎるので、適切ではないように
>思います。私なら右クリックイベントに変えて

についてですが、上述の《.Characters.Text = Cap1》を除いて試してみましたが右クリックで切替を行う場合、右クリックせずにボタンを押してしまう可能性があります。マクロ実行にActiveCellの色で禁則条件を加えれば良いのかもしれませんが、不特定の人間が作業することを目標としていますので、ちょっと問題があるかなと思えます。スピードかクリック回数減か検討してみます。

また、シート中に計算式として、以下のFunction R_XXX_test()が複数配置されてており、罫線の記入にてシート上の数値をリアルタイムで変化させたいため、A1セルをセル選択イベントで書換えFunction R_XXX_test()を再計算させています。

Function R_XXX_test(YOKO As Variant, XXX_P As Variant, _
      XXX_XX As Double, リフレッシュ As Variant)
  'リフレッシュにA1を取り込みセル移動で毎回計算させる
  '罫線情報取得テスト
    Dim shoukei, YOKO_XX
    shoukei = 0
    If YOKO.Value = "" Then YOKO_XX = 0 Else YOKO_XX = YOKO.Value
    If KIKI_P.Borders(xlEdgeRight).LineStyle <> xlNone Then
         shoukei = shoukei + XXX_XX
    If YOKO.Borders(xlEdgeBottom).LineStyle <> xlNone Then
         shoukei = shoukei + YOKO_XX
    If shoukei = 0 Then R_XXX_test = "" Else _
         R_XXX_test = shoukei
End Function


>
>Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, _
>Cancel As Boolean)
>  Dim AcPro1 As String, AcPro2 As String
>  Dim Cap1 As String, Cap2 As String
>
>  Cancel = True
>  Select Case Target.Interior.ColorIndex
>    Case 24
>     AcPro1 = "model_11": AcPro2 = "model_12"
>     Cap1 = "道具L字追加": Cap2 = "道具T字追加"
>    Case 35
>     AcPro1 = "model_31": AcPro2 = "model_32"
>     Cap1 = "コネクタ横伸長": Cap2 = "コネクタ縦伸長"
>    Case Else
>     AcPro1 = "": AcPro2 = ""
>     Cap1 = "": Cap2 = ""
>  End Select
>  With ActiveSheet.Shapes("Button 8")
>    .OnAction = AcPro1: .Characters.Text = Cap1
>  End With
>  With ActiveSheet.Shapes("Button 9")
>    .OnAction = AcPro2: .Characters.Text = Cap2
>  End With
>End Sub

【35551】Re:マクロボタンの 登録マクロ切り替え
発言  Kein  - 06/3/7(火) 16:07 -

引用なし
パスワード
   >でエラーになります。
ボタンはフォームツールバーのものでしょうか ? ならば .Characters を消して単に

.Text = Cap1

と変更してみて下さい。
>右クリックせずにボタンを押してしまう可能性があります
ダブルクリックだと、どうでしょーか ? 右クリックより強い意思が必要なので、
間違いが少なくなると思います。あるいは一度メッセージを出して確認する↓

If MsgBox("本当に登録するマクロを変更しますか", 36) = 7 Then Exit Sub

という手もあります。いずれにせよ、セル選択イベントよりは適切なマクロになる
はずですが・・。
>A1セルをセル選択イベントで書換えFunction R_XXX_test()を再計算
何かよく分からないけど、再計算ぐらいなら F9キー でやる方がいいような気が
します。やたらとマクロを使うよりは・・。

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