EXCEL VBAでこんなことできますか？

質問

エクセルに地図を貼り付けて、ある地点（A)を中心に１キロ、２キロの円を罫線で描いています。同じように、別のある地点（B)からも同様に円「を描いています。
メッセージボックスか、インプットボックスを使って、Å、Ｂと入力したときにそれに該当する円を表示する方法はありますか？
急いでいるので出来るだけ早い返信お願いします。

回答No.1

asahina02 · ベストアンサー

このような感じでいかがでしょうか？

Dim myShape As shape
Dim top As Integer
Dim left As Integer
Dim width As Integer
Dim height As Integer

'　左上座標、幅、高さを計算する
'　中心点と1キロの幅が分かれば左上座標が計算できるかと
'　幅、高さは1キロ×２になりますね

Set myShape = ActiveSheet.Shapes.AddShape(Type:=msoShapeOval, top:=top, left:=left, width:=width, height:=height)

With myShape
'　ここで作った円の状態を設定します。
'　ちなみに以下は「塗りつぶしなし」にしています。
.Fill.Visible = msoFalse
End With

補足

早い返事を・・・と言いながら今更の補足ですみません。
このマクロについてもう少し教えて頂きたいのですが、ここに書かれてある“左上座標”とはＡ1やＨ10と言った具合にセルの場所を入力するのですか？もし、入力するのであれば、top=ｈ１０いいった感じの入力方法でよいのでしょうか？

回答No.7

moon00

補足を拝見しました。
赤く表示させた後に、「線なし」にする、ということでよろしいですか。
その場合、
--------------------------------
Sub hyoji()
Selection.ShapeRange.Line.Visible = msoTrue
'「線なし」に設定されている場合、線を表示
Selection.ShapeRange.Line.ForeColor.SchemeColor = 10
Range("A1").Select
End Sub
---------------------------------
Sub modosu()
Selection.ShapeRange.Line.Visible = msoFalse
'「線なし」に設定
Range("A1").Select
End Sub
---------------------------------
実際、「線なし」にするのは、modosuマクロの方ですが、
その状態になったものをまた表示するときに、元のままでは
不具合が出るので、hyojiマクロも修正しました。

こういった変更は、ツール→マクロ→マクロの記録で
実際「線なし」の表示にしてみる、「赤」に変更してみる、
で、そのマクロをMicrosoft Visual Basicで見て比べて、
どこがその命令（コード）になっているかを探っていくと、
やりたいことができるようになっていきますよ。

回答No.6

asahina02

#1です。

>このマクロについてもう少し教えて頂きたいのですが、ここに書かれてある>“左上座標”とはＡ1やＨ10と言った具合にセルの場所を入力するので
>すか？もし、入力するのであれば、top=ｈ１０いいった感じの入力方法でよ>いのでしょうか？

座標はセルの場所ではなく、シートの左上からのピクセル位置になります。
なのでtopとかleftに入るのは　数値　です。

回答No.5

moon00

補足です。
というか、私は上記質問を
「すでにオートシェイプで円が描かれている」という前提で
回答をしました。
なので、該当する円を見やすくするためのVBAです。

＃4さんがおっしゃるように、オブジェクトで貼り付けた
地図のある1点をマウスなりで指定して、その1キロ、2キロを
表示というのは、VBAだけでは解決できませんね。

補足

早い返信を・・・と言いながら今さら補足させて頂きます。失礼かとは思いますが、教えていただけますでしょうか？
このマクロについてなのですが、メッセージボックスに“Ａ”と入力した場合にShapes1とShapes２が赤く表示され、その後黒になりますが、これを“線なし”にすることは可能でしょうか？

回答No.4

Wendy02

こんばんは。

＞エクセルに地図を貼り付けて、ある地点（A)を中心に１キロ、２キロの円を罫線で描いています。

私には、簡単には出来ませんね。地図というのは、オブジェクトではないでしょうか？そのA地点とか出すのでしょうか？オブジェクトですと、見つけられないし、仮にA地点を決めても、そのScreen座標を取らなくてはならないと思います。

セル上なら、たぶん、Find メソッドで、Aを見つけたそのセルの .Top と.Left 位置を取り、その(半径*半径)^(1/2)[その大きさは分りません] の距離だけ、x(Top) と y(Left) を、マイナス値に移動することになるわけですね。

私には、もう少し、情報をいただかないと、とても出来ません。

回答No.3

moon00

該当のファイルにて
ツール→マクロ→Microsoft Visual Basicを開いてください。
挿入→標準モジュールで出てきた画面に下のコードをペーストします。（マクロ間を区切っている「-----」は消してください）
※図形の番号Shapes(*)はここで該当のものに書き換えてください。

Microsoft Visual Basicを閉じて、ツール→マクロ→マクロのダイアログボックスから「iro」を選択して実行します。

ボタンを作りたい場合は、オートシェイプで丸でも四角でも作成し、
その図形を選択して右クリック→マクロの登録で、「iro」を選択します。
これでその図形を押せば、マクロが実行されます。

VBAの基本的なHPを下記に紹介しておきます。
http://www.moug.net/
http://www.sk2.aitai.ne.jp/~happy/

回答No.2

moon00

＞該当する円を表示する方法
というのを色を変更する、という方法をとってみました。
サンプルはインプットボックスで地点を指定し、該当の円を赤色に変更
確認メッセージを出して、色を「自動」に戻します。
地点はA,Bのみとし、その他が入力されたときには
メッセージを出します。
3種類のマクロを使用しています。
-------------------
Sub iro()
Dim i As Variant
i = InputBox("表示する地点を指定してください", "地点指定")
If i = "A" Then
ActiveSheet.Shapes(1).Select
ActiveSheet.Shapes(2).Select Replace:=False
hyoji
MsgBox "表示を終了してよろしいですか", vbOKOnly
ActiveSheet.Shapes(1).Select
ActiveSheet.Shapes(2).Select Replace:=False
modosu

ElseIf i = "B" Then
ActiveSheet.Shapes(3).Select
ActiveSheet.Shapes(4).Select Replace:=False
hyoji
MsgBox "表示を終了してよろしいですか", vbOKOnly
ActiveSheet.Shapes(3).Select
ActiveSheet.Shapes(4).Select Replace:=False
modosu

Else
MsgBox "指定した地点がありません", vbOKOnly
End If

End Sub
--------------------------
Sub hyoji()
Selection.ShapeRange.Line.ForeColor.SchemeColor = 10
Range("A1").Select

End Sub
---------------------------
Sub modosu()
Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
Range("A1").Select

End Sub
---------------------------
Shapes(*)←この数字は、図形の作られた順番で付きます。
該当の図形が何番かわからない場合には、
図形を右クリックして「マクロを登録」を選択したとき、
円なら「楕円*_Click」と出ますので、その番号になります。

補足

スミマセン。
ＶＢＡ初心者のため、どこに入力していいかわからないのでもう少し具体的にお願いします。