Excel VBA質問箱 IV

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

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


46195 / 76732 ←次へ | 前へ→

【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

13 hits

【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 発言

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