図形描画を作成ボタンを作成するには？

Question

エクセルで表を作成しています。
ある状態を監視し、その状態を図形描画の「→」（矢印）を利用して平行、傾き右斜め下向き、右斜め上向きの３つの矢印で状態を表すようにしています。
この時、一度作成した図形があるセルをコピーして貼り付けていますが、
マクロ（？）などで、ボタンを３つ作成して簡単に矢印を該当セルに作成すること方法はありませんか？
質問が支離滅裂ですみません。

nishi6 · Accepted Answer

やっと、回答したコードをExcel97で実行できました。特に問題なく動きました・・・

確認ですが、回答に書いた、

『Sheet1に平行、傾き右斜め下向き、右斜め上向きの矢印を書きます。 
　この３つの矢印に名前ボックス（シート左上）を使って、 
　平行な矢印に『LineEv』、右斜め上向きに『LineUp』、下向きに『LineDw』の名前をつけます。 』

は、各ボタンと図形を関連付けるために、登録の意味合いで、どこか変更しない位置に３種類の矢印を書いて名前を付けます。
まず、３種の矢印に指定した名前がついているか確認して下さい。
使い方としては、別の矢印を書きたいセルを選択してボタンを押せば、ボタンに対応した矢印が出ます。これは別のボタンを押せば変更できます。
コピーとか貼り付けの処理はしません。


補足によると、シートが毎月、追加（変更）されるようなので、シートに関係しない方法を考えてみました。
また、図形の矢印ではなく、全角の『→』を使って、水平、右上向き、右下向き矢印を書いています。
コードの『45、-45』を変更すれば角度が指定できます。
ツールバーを作っているので、シートに関係なく使用できます。ご参考に。

標準モジュールに貼りつけます。
コマンドバーのアイコンは適当なものがなかったので、水平と上・下矢印にしてあります。
CommandBar_ArrowButtonでコマンドバーを追加
CommandBar_ArrowButtonDelでコマンドバーを削除します。

ここから
↓
'コマンドバー『矢印ボタン』を追加
Sub CommandBar_ArrowButton()
　　Dim myBar As CommandBar                        'コマンドバー
　　Dim myControl(1 To 3) As CommandBarControl     'コマンドバー内のコマンドボタン
　　Dim i As Integer                               'カウンタ

　　On Error Resume Next
　　CommandBars("矢印ボタン").Delete   'コマンドバーの名前を『矢印ボタン』とする
　　On Error GoTo 0

　　Set myBar = CommandBars.Add(Name:="矢印ボタン", Position:=msoBarFloating, Temporary:=True)
　　With myBar
　　　　.Protection = msoBarNoChangeDock
　　　　.Left = 50
　　　　.Top = 100
　　End With

　　'コマンドバーにボタンを作る
　　For i = 1 To 3
　　　　Set myControl(i) = myBar.Controls.Add(Type:=msoControlButton, Temporary:=True)
　　　　With myControl(i)
　　　　　　Select Case i
　　　　　　　　Case 1: .TooltipText = "水平矢印です。"
　　　　　　　　　　　　.FaceId = 1142
　　　　　　　　Case 2: .TooltipText = "右上向き矢印です。"
　　　　　　　　　　　　.FaceId = 1144
　　　　　　　　Case 3: .TooltipText = "右下向き矢印です。"
　　　　　　　　　　　　.FaceId = 1145
　　　　　　End Select
　　　　　　.OnAction = "'ArrowDrow " & i & "'"  'マクロを割り当て
　　　　End With
　　Next
　　myBar.Visible = True
End Sub

'文字の『→』を傾きをつけて書く
Sub ArrowDrow(Kubun As Integer)
　　Dim rg As Range          'セル
　　Dim ortSet As Long       '文字の傾き
　　Dim rwHeight As Long     '最初のセルの高さ

　　Select Case Kubun
　　　　Case 1: ortSet = 0      '水平
　　　　Case 2: ortSet = 45     '右上向き
　　　　Case 3: ortSet = -45    '右下向き
　　End Select

　　Application.ScreenUpdating = False
　　'複数セルを選択している場合の対応
　　For Each rg In Selection
　　　　rg = "→"
　　　　With rg
　　　　　　rwHeight = .RowHeight              'セルの高さを退避
　　　　　　.Orientation = ortSet              '文字の傾き
　　　　　　.HorizontalAlignment = xlCenter    '水平位置で中央
　　　　　　.VerticalAlignment = xlCenter      '垂直位置で中央
　　　　　　.RowHeight = rwHeight              'セルの高さを最初と同じにする
　　　　End With
　　Next
　　Application.ScreenUpdating = True
End Sub

'コマンドバー『矢印ボタン』を削除
Sub CommandBar_ArrowButtonDel()
　　On Error Resume Next
　　CommandBars("矢印ボタン").Delete
　　On Error GoTo 0
End Sub

nishi6 · Answer

＞ボタンはどのように作るのでしょうか？
＞１回目に記述した標準モジュールは消した方がいいんですよね？ 

出ないのは？ですね。では、図形を使わない方法です。
まず、新規ブックを開いて、それに対して行ってみます。

ツール→マクロ→Visual Basic Editor でVBE画面に移り、 挿入→標準モジュール で標準モジュールを挿入し、出てきたコードウインドウに#4のマクロをコピーして貼り付けます。 （#4の↓の下から全部）


シートに戻り、ツール→マクロ→マクロ で
　CommandBar_ArrowButton を実行すれば、コマンドバーを追加 
　CommandBar_ArrowButtonDel を実行すれば、コマンドバーを削除します。 

CommandBar_ArrowButtonを実行すれば、３つのボタンを持ったツールバーが、画面左上にできるはずです。
矢印を書くのにこのツールバーのボタンを使います。
　　セルを選択して、このコマンドバー内のボタンを押せば、ボタンに対応して
　　→、右上向き→、右下向き→がセルに書かれるはずです。


新規ブックで試して、同じ手順で、目的のブックにマクロを登録します。
その時は、不要なマクロは全て削除したおいたほうがいいでしょう。

nishi6 · Answer

Sheet1で行います。Sheet1にコントロールツールボックスのコマンドボタンを4つ作ります。

　CommandButton1　Captionは『－』　　 平行な矢印を書く機能
　CommandButton2　Captionは『Up』　　 右斜め上向き矢印を書く機能
　CommandButton3　Captionは『Down』　 右斜め下向き矢印を書く機能
　CommandButton4　Captionは『Del』　　選択したセルにある矢印を消去する機能にします。

選択したセルに既に別の矢印があったら書き換え、複数のセルを選択した時も機能させます。

Captionはコマンドボタンを右クリックしてプロパティを選択してプロパティウインドウを出して設定します。

Sheet1に平行、傾き右斜め下向き、右斜め上向きの矢印を書きます。
この３つの矢印に名前ボックス（シート左上）を使って、
　平行な矢印に『LineEv』、右斜め上向きに『LineUp』、下向きに『LineDw』の名前をつけます。


ツール→マクロ→Visual Basic Editor でVBE画面に移り、 表示→プロジェクトエクスプローラでプロジェクトエクスプローラを表示します。プロジェクトエクスプローラのSheet1をダブルクリック。出てきたコードウインドウに下記マクロをコピーして貼り付けます。

ここから 4つ目の End Sub まで
↓
Private Sub CommandButton1_Click()
　　ShapeDrow 0
End Sub

Private Sub CommandButton2_Click()
　　ShapeDrow 1
End Sub

Private Sub CommandButton3_Click()
　　ShapeDrow 2
End Sub

Private Sub CommandButton4_Click()
　　ShapeDrow 3
End Sub
↑
ここまで

次に、VBE画面で、挿入→標準モジュール で標準モジュールを挿入します。 
出てきたコードウインドウに下記マクロをコピーして貼り付けます。

ここから End Sub まで
↓
Sub ShapeDrow(Kubun As Integer)
　　With Worksheets("Sheet1")
　　　　Select Case Kubun
　　　　　　Case 0: .Shapes("LineEv").Copy  '平行
　　　　　　Case 1: .Shapes("LineUp").Copy  '上向き
　　　　　　Case 2: .Shapes("LineDw").Copy  '下向き
　　　　End Select
　　End With

　　Dim selArea As Range        '選択範囲
　　Set selArea = Selection

　　Dim shp As Shape            '図形
　　Dim rg As Range             'セル
　　'とりあえず選択範囲内の図形を消去する
　　For Each shp In Worksheets("Sheet1").Shapes
　　　　If Not Intersect(Range(shp.TopLeftCell.Address), selArea) Is Nothing Then
　　　　　　'選択範囲に図形のセルが含まれていれば削除する
　　　　　　shp.Delete
　　　　End If
　　Next

　　'消去する命令だったら処理を終わる
　　If Kubun = 3 Then Exit Sub

　　'選択範囲のセルに全て複写する
　　For Each rg In selArea
　　　　rg.Select
　　　　ActiveSheet.Paste
　　Next
　　selArea.Cells(1, 1).Select
End Sub
↑
ここまで

シートに戻って、デザインモードを解除します。
矢印を表示したいセルを選択して表示した矢印のボタンを押します。
セルは、単一、複数、Shift・Ctrlキーを使って選択できます。当方Excel2000です。

ご参考に。

imogasi · Answer

こう言うことをしたいのではないのでしょうか。
質問の意味が良く掴めず、推定して答えています。
外れていたとしても、下記は参考になると思います。ぜひ
やって見てください。
データをＡ１からＢ７まで、例えば
14
21
43
56
62
36
42
と入力します。
ＶＢＥのＭｏｄｕｌｅ１に
Sub Ｔｅｓｔ01()
For i = 1 To 7
    l = Cells(i, 3).Left
    t = Cells(i, 3).Top
    h = Cells(i, 3).Height
  If Cells(i, 1) < Cells(i, 2) Then
    Worksheets("Sheet1").Shapes.AddLine(l, t, l + 20, t + h).Select
    Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadTriangle
    Selection.ShapeRange.Line.EndArrowheadLength = msoArrowheadLengthMedium
    Selection.ShapeRange.Line.EndArrowheadWidth = msoArrowheadWidthMedium
    Selection.ShapeRange.Flip msoFlipVertical
    Else
    Worksheets("Sheet1").Shapes.AddLine(l, t + h, l + 20, t).Select
    Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadTriangle
    Selection.ShapeRange.Line.EndArrowheadLength = msoArrowheadLengthMedium
    Selection.ShapeRange.Line.EndArrowheadWidth = msoArrowheadWidthMedium
    Selection.ShapeRange.Flip msoFlipVertical
 End If
 Next i
End Sub
と入力し実行します。
Ａ列よりＢ列の数字が増えていれば、Ｃ列に上向き矢印、減っていればＣ列に下向き矢印をセットします。＝の時を今回は割愛しました。
一部マクロの自動記録を使っていますので、特徴が出ています。（Ｓｅｌｅｃｔｉｏｎの多出）ご免。

misatoanna · Answer

お尋ねの内容を取り違えているかも知れませんが――
このようなことでよいのでしょうか？
---------------------------------------------
まず、「平行、右斜め上向き、右斜め下向き」の３つの矢印の図形を、それぞれ適当なフォルダに適当な名前で保存してください。
次に当該ブックを開き、[ツール]-[マクロ]-[VisualBasicEditor] で起動される画面から [挿入]-[標準モジュール] と進み、開いた編集画面に次のコマンドをコピーしてから、Editor を閉じてください。
'---- ここから ----------
Sub 水平矢印()
ActiveSheet.Pictures.Insert("aaaaa").Select
End Sub
Sub 上昇矢印()
ActiveSheet.Pictures.Insert("bbbbb").Select
End Sub
Sub 下降矢印()
ActiveSheet.Pictures.Insert("ccccc").Select
End Sub
'---- ここまで ----------
aaaaa、bbbbb、ccccc は、図形保存場所のフルパスに置き換えてください。
次に、ワークシートの一番上あたりの使っていないセルに、保存した３つの矢印の図形を呼び出して並べてください。
並べた図の中の「平行」を示す図形を右クリックして「マクロの登録」を選択し、表示されたボックスから「水平矢印」マクロを選択して[ＯＫ]。
他の２つについても同様の操作で、該当するマクロを選択します。
-------------------------------------------------
以上です。
あとは、矢印を描きたいセルをクリックしてから、マクロを割り当てた図形をクリックしてください。

図形描画を作成ボタンを作成するには？

やっと、回答したコードをExcel97で実行できました。

この回答への補足

＞ボタンはどのように作るのでしょうか？

この回答への補足

Sheet1で行います。

この回答への補足

こう言うことをしたいのではないのでしょうか。

お尋ねの内容を取り違えているかも知れませんが――

この回答への補足

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング