| |
ご回答、ありがとうございます。
頂いた内容ですと、ボタンクリックに対して内容の入れ替えが起きるので意図しているものと違うようです。応用すればよいのでしょうから検討してみます。
あれから自分で作成したものを以下に示します。マクロの切り替えはこれで出来るのですが、マクロ実動作の際に問題がおきますのでご助言お願いします。
(1)、(2)の2箇所あるのですが、ともに[Select]を使っているために問題があるようです。（Selectの際にマクロ切替作業が入るため？）ただし下記の記述ではうまくいかなかったのでSelectを利用しています。
(1) ＯＫ ActiveSheet.Shapes("Button 8").OnAction = "model_11"
駄目 ActiveSheet.Shapes("Button 8").Characters.Text = "道具Ｌ字追加
(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 = "道具Ｌ字追加"◆※(1)※◆
ActiveSheet.Shapes("Button 9").Select
Selection.OnAction = "model_12"
Selection.Characters.Text = "道具Ｔ字追加"
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()
' モデリング道具Ｌ字追加
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
|
|
下働き
- 06/3/7(火) 10:08 -
