Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

2067 / 13645 ﾂﾘｰ

←次へ　｜　前へ→

▼

【70015】下記 じょにー 11/10/9(日) 16:32

【70016】Re:下記 UO3 11/10/9(日) 17:42

【70019】申し訳ありません。 じょにー 11/10/9(日) 18:24

【70020】Re:申し訳ありません。 kanabun 11/10/9(日) 19:35

【70021】Re:申し訳ありません。 kanabun 11/10/9(日) 20:00

【70022】大変ありがとうございました じょにー 11/10/9(日) 20:03

【70024】もう一つだけ質問させて下さい じょにー 11/10/11(火) 10:30

【70025】Re:もう一つだけ質問させて下さい UO3 11/10/11(火) 17:01

【70028】ご解説ありごとうございます。 じょにー 11/10/11(火) 17:16

【70119】また、質問させて下さい じょにー 11/10/16(日) 16:20

【70120】Re:また、質問させて下さい UO3 11/10/16(日) 17:16

【70121】Re:また、質問させて下さい じょにー 11/10/16(日) 17:33

【70122】Re:また、質問させて下さい UO3 11/10/16(日) 17:37

【70123】Re:また、質問させて下さい じょにー 11/10/16(日) 17:50

【70124】Re:また、質問させて下さい じょにー 11/10/16(日) 19:11

【70203】また少し教えて下さい。 じょにー 11/10/19(水) 14:01

【70211】Re:また少し教えて下さい。 UO3 11/10/19(水) 19:42

【70214】解りました じょにー 11/10/19(水) 19:50

【70235】ありがとうございました。 じょにー 11/10/21(金) 8:42

【70215】Re:また少し教えて下さい。 kanabun 11/10/19(水) 20:17

【70217】はい、試しました。 じょにー 11/10/19(水) 20:30

【70218】Re:はい、試しました。 kanabun 11/10/19(水) 20:40

【70220】Re:はい、試しました。 kanabun 11/10/19(水) 23:04

【70234】ありがとうございました。 じょにー 11/10/21(金) 8:06


	【70015】下記

じょにー

- 11/10/9(日) 16:32 -


	引用なし

	パスワード

２回目の投稿となります。前回の投稿で、kanabunさまが、おっしゃっていただいた様に今回はもう少し内容を具体的に質問させて
もらいます。ワークシートのセル上でダブルクリックした時にクリックしたセル上にシャイプがあれば、消して、無ければ無地の２重丸の
シェイプを配置をすると言うマクロを作りたくて、色んな所から、引用して作ってみましたが、単体での、シェイプを配置したり、シェイプを
消してみたり、シェイプが配置してあるかの判断とかは、ちゃんと動きましたが、それをひとつにまとめると、最初の数回は、思った通りに動きましたが、何回か
行っているうちにシェイプを配置しなくなるとか、シェイプの消去の部分でエラーが出るなどの不具合が出てきました。一応見難いとは、思いますが下記に記載したコードを添付しておきましたので、
おかしな所があるのであれば、ご指導下さい。
----Sheet1に記載----
Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim sh As Shape
Dim c As Long
　　For Each sh In ActiveSheet.Shapes
　　　　If Not Application.Intersect(Target, sh.TopLeftCell) Is Nothing Then
　　　　Call Module1.DelShape(Target)
　　　　Else
　　　　Call Module1.AddShape(Target)
　　　　
　　　　End If
　　Next sh
End Sub
----Module1に記載----
Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim sh As Shape
Dim c As Long
　　For Each sh In ActiveSheet.Shapes
　　　　If Not Application.Intersect(Target, sh.TopLeftCell) Is Nothing Then
　　　　Call Module1.DelShape(Target)
　　　　Else
　　　　Call Module1.AddShape(Target)
　　　　
　　　　End If
　　Next sh
End Sub

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
Call Module1.AddShape(Target)
End Sub


	【70016】Re:下記

UO3 - 11/10/9(日) 17:42 -


	引用なし

	パスワード

▼じょにーさん：

回答ではありません。
質問文は具体的ですが、表題は　？ですね。まぁ、それはさておき。

シートモジュールから呼び出されるDelShapeとAddShapeのアップがなく、
なぜか標準モジュールにシートイベントプロシジャが記載されてますが？


	【70019】申し訳ありません。

じょにー

- 11/10/9(日) 18:24 -


	引用なし

	パスワード

今回の投稿は、私のコードのコピペのミスや、タイトルの記入ミスで、多くの諸先輩方々に、ご迷惑をおかけしました。改めて、コードの方を添付させてもらいますので、是非、ご指導をお願いいたします。
---------------------------------------------------------------------------
----Sheet1に記載----
Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim sh As Shape
Dim c As Long
　　For Each sh In ActiveSheet.Shapes
　　　　If Not Application.Intersect(Target, sh.TopLeftCell) Is Nothing Then
　　　　Call Module1.DelShape(Target)
　　　　Else
　　　　Call Module1.AddShape(Target)
　　　　
　　　　End If
　　Next sh
End Sub
----Module1に記載----
Option Explicit
Sub AddShape(Target As Range)
Dim t As Single
Dim l As Single
Dim h As Single
Dim w As Single
Target.HorizontalAlignment = xlCenter
t = Target.Top
l = Target.Left
h = Target.Height
w = seru.Width
ActiveSheet.Shapes.AddShape(msoShapeDonut, l, t, w, h).Select
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)

End Sub
Public Sub DelShape(Target As Range)
Dim sh As Shape
　For Each sh In ActiveSheet.Shapes
　　　　If Not Application.Intersect(Target, sh.TopLeftCell) Is Nothing Then
　　　　sh.Select
　　　　 Selection.Delete
　　　　End If
　　Next sh
End Sub


	【70020】Re:申し訳ありません。

kanabun - 11/10/9(日) 19:35 -


	引用なし

	パスワード

▼じょにーさん：こちらで継続されるということになったようで... それならそれで構いませんが、後々のため、元スレはそのむね明記して閉じておいたほうがよろしいかと。コード拝見させていただきました。それに沿って、各プロシージャについて、こんな風に変更したらどうかという修正案を下記に示します。 '--- Sheet1 モジュール --- Option Explicit Private Sub Worksheet_BeforeDoubleClick( _ ByVal Target As Range, Cancel As Boolean) Dim sh As Shape Dim c As Long 　　Cancel = True 　　For Each sh In ActiveSheet.Shapes 　　　　If Not Application.Intersect(Target, sh.TopLeftCell) Is Nothing Then 　　　　　　Call Module1.DelShape(sh.Name) 'その名前のShapeを消す　　　　　　Exit Sub 　　　　End If 　　Next sh 　　Call Module1.AddShape(Target) End Sub '--- Module1 --- Option Explicit Public Sub AddShape(Target As Range) 　　With Target 　　　　.HorizontalAlignment = xlCenter 　　　　With ActiveSheet.Shapes.AddShape(msoShapeDonut, _ 　　　　　　　　.Left, .Top, .Width, .Height) 　　　　　　.Fill.Transparency = 0# 　　　　　　.Line.ForeColor.SchemeColor = 64 　　　　　　.Line.BackColor.RGB = RGB(255, 255, 255) 　　　　　　.Select 　　　　End With 　　End With End Sub Public Sub DelShape(ShpName As String) 　　ActiveSheet.DrawingObjects(ShpName).Delete End Sub


	【70021】Re:申し訳ありません。

kanabun - 11/10/9(日) 20:00 -


	引用なし

	パスワード

'---- Module1 ------ のほうは、こうしたほうが良かったかもしれません。 Public Sub AddShape(ByVal Target As Range) 　　With Target 　　　　.HorizontalAlignment = xlCenter 　　　　With ActiveSheet.Shapes.AddShape(msoShapeDonut, _ 　　　　　　.Left, .Top, .Width, .Height) 　　　　　　.Fill.Transparency = 0# 　　　　　　.Line.ForeColor.SchemeColor = 64 　　　　　　.Line.BackColor.RGB = RGB(255, 255, 255) 　　　　　　.OnAction = "Module1.DelShape2"　'◆追加1 　　　　　　.TopLeftCell.Select 　　　　End With 　　End With End Sub Public Sub DelShape(ShpName As String) 　　With ActiveSheet.DrawingObjects(ShpName) 　　　　.BottomRightCell.Select 　　　　.Delete 　　End With End Sub Public Sub DelShape2()　'◆追加2 　　DelShape Application.Caller End Sub ---- ◎があるセルをダブルクリックするのはセルの上にある図形が邪魔をしてダブルクリックしにくいことがあるので、 ◎を描くとき、マクロを登録しておいて(◆追加1 の行)、 (1)消したい図形の下にあるセルがダブルクリックされたら、これまでどおり　　その図形の名前を指定して DelShapeプロシージャを呼び出す。 (2)そうではなく、図形のほうがクリックされたら、　　DelShape2プロシージャ(◆追加2 のほう)が自動で呼ばれて、その　　クリックされた図形の名前(Application.Caller) を指定して内部で　　DelShapeを呼び出すという感じです。


	【70022】大変ありがとうございました

じょにー

- 11/10/9(日) 20:03 -


	引用なし

	パスワード

anabun様、コードのご提示と、掲示板への書き込み等の指摘、大変ありがとうございます。さて本題のコードの方ですが、ご提示いただいた物で、早速試した所、まさに理想の動きをいたしました、これで、安心して、今日からぐっすり眠れそうです。また、次回掲示板への投稿等は、もう少し、ここのルールを、覚えてからいたします。今回は、少々焦って投稿してしまったので、コードやタイトルの記入ミスをしてしまい、諸先輩方々に大変ご迷惑をおかけ致しまた


	【70024】もう一つだけ質問させて下さい

じょにー

- 11/10/11(火) 10:30 -


	引用なし

	パスワード

オートシェイプの色や、線の種類等、書式をＶＢＡで変更をしたいのですが。オートシェイプのプロパティ値？がいまいちよく解っていませんので、何処を変更すればいいか、また追加すればいいか、解る書籍やサイトがあれば、ご紹介下されば助かります。


	【70025】Re:もう一つだけ質問させて下さい

UO3 - 11/10/11(火) 17:01 -


	引用なし

	パスワード

▼じょにーさん：

こんにちは

シェープそのもの（？）は、割合とわかりやすいのですが、Ｅｘｃｅｌで扱う様々な（異なる）要素が
シェープという名の下に統合（いいかえると、ごちゃまぜ）されていて、そのプロパティが
必ずしも、シェープ.プロパティ　ではなく、シェープ.○○○.プロパティと指定しなければいけないものが多く
しかも、この○○○は、それこそ様々なので、わかりにくくなっているのでしょうね。

たまたま私が持っている書籍に限れば、あまりおすすめできるものはありません。
というか、シェープそのものにたくさんのページを割いている書籍は少ないかも。
たとえば、大村あつしさんの「かんたんプログラミング」基礎編の付録にシェープの階層構造を記述したページが
ありますが、この１ページだけのためにわざわざ購入するのも・・・・？

ＶＢＡ　シェープ　プロパティ　あたりで検索すると、役に立ちそうなものがヒットするかもしれません。
たとえば

www.clayhouse.jp/vba/vba03.htm
www.asahi-net.or.jp/~zn3y-ngi/YNxv9e056.html

私の場合は、主に３つの方法で確認しています。

１．いわゆるマクロ記録で様々な属性を設定する操作を記録して、できあがったコードを参照します。
２．ＶＢＥ画面の表示（Ｖ）－＞オブジェクトブラウザ（Ｏ）で、クラス欄のShapeを選び
　　右側に列挙されるメンバをクリックして、「？」ボタンを押してヘルプを表示。
　　このとき、オブジェクトブラウザの任意の場所で、右クリックして非表示のメンバの表示としておくと
　　通常は非表示になっているものも表示させることができます。
３．調べたいシェープをシートに作成し

　　Sub Test()
　　　　Dim sp As Shape
　　　　Set sp = ActiveSheet.Shapes("そのシェープの名前")
　　　　Stop
　　End Sub

　　上記を実行。Stopで中断しますので、ＶＢＥ画面の表示（Ｖ）－＞ローカルウィンドウ（Ｓ）で
　　変数リストを表示させ、(+)sp とんっているシェープオブジェクトの (+) を開いて、その階層を
　　どんどん追いかけます。


	【70028】ご解説ありごとうございます。

じょにー

- 11/10/11(火) 17:16 -


	引用なし

	パスワード

UO3様書籍の紹介と参照ＵＲＬの紹介及びＶＢＥでの操作方法の紹介ありがとうございます。
書籍の方は、１ページだけなら、まぁ置いといてＵＲＬの紹介と、ＶＢＥでの操作方法は、大変役に立つ物でした。どうもありがとうございました。


	【70119】また、質問させて下さい

じょにー

- 11/10/16(日) 16:20 -


	引用なし

	パスワード

前回、kanabun様のご協力でダブルクリックしたセルにオートシェイプを描いたり、消したりするコードをご教授いただきましたが
別スレッドにて、UO3様にてEXECL2007での、シェイプの絵画方法をご伝授いただき、この２つを組み合わせて、自分なりに少し作ってみましたが
A1のセルに1が入っている時はダブルクリックした所に丸を描き
1以外なら2重丸を描いて、シェイプをダブルクリックすると消すと言う事をやってみようと思い下記の用なコードを書いてみましたが
丸の時は、ダブルクリックでちゃんと消えますが、2重丸の時はシェイプの選択になって消えません、どの様に手を加えたら良いのか、諸先輩方々の
お知恵を拝借出来れば幸いですセルの大きさは、列が2、行が16くらいでやっております。EXECL2007でのご指導を頂けると嬉しいです。
-----[Sheet1に記載]-----
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim sh As Shape
Dim c As Long
Dim flag As Boolean
Cancel = True
If Range("A1").Value = 1 Then
flag = True
Else
flag = False
End If
　
　　For Each sh In ActiveSheet.Shapes
　　　　If Not Application.Intersect(Target, sh.TopLeftCell) Is Nothing Then
　　　　　　Call Module1.DelShape(sh.Name)
　　　　　　Exit Sub
　　　　End If
　　Next sh
　　Call Module1.AddShape(Target, flag)
Target.Offset(1, 0).Select
End Sub
-----[Module1に記載]-----
Option Explicit

Public Sub AddShape(Target As Range, flag As Boolean)
　　If flag Then
　　With Target
ActiveSheet.Shapes.AddShape(msoShapeOval, .Left, .Top, .Width, .Height).Select
　　End With
　　Selection.ShapeRange.Fill.Visible = msoFalse
　　With Selection.ShapeRange.Line
　　　 .ForeColor.ObjectThemeColor = msoThemeColorText1
　　　　.Visible = msoTrue
　　　　.Weight = 0.25
　　End With
　　Else
　　With Target
ActiveSheet.Shapes.AddShape(msoShapeDonut, .Left, .Top, .Width, .Height).Select
　　End With
　　Selection.ShapeRange.Fill.Visible = msoFalse
　　With Selection.ShapeRange.Line
　　　 .ForeColor.ObjectThemeColor = msoThemeColorText1
　　　　.Visible = msoTrue
　　　　.Weight = 0.25
　　End With
　　End If
　　End Sub

Public Sub DelShape(ShpName As String)
　　ActiveSheet.DrawingObjects(ShpName).Delete
End Sub


	【70120】Re:また、質問させて下さい

UO3 - 11/10/16(日) 17:16 -


	引用なし

	パスワード

▼じょにーさん：

こんにちは

理由そのものは単純です。
今回、塗りつぶしなしにしておられるので、図形の下のセルを選択することが可能で
従ってセルに対するダブルクリックもできる・・・・・

ただ・・・塗りつぶしなしにしても、「線と、その隣接した若干の領域」は塗りつぶされていません。

具体的には、（マウスポインターの形状を変えておられないとすれま）マウスをあてたとき
赤十字のマークのようになっていれば、図形の下のセルにポイントがあり、矢印マークになっていれば
図形上にポイントがあるということなんです。

図形上にポイントがある状態でダブルクリックしてもセルのダブルクリックイベントは発生せず、
単に図形が選ばれただけということになります。

セルの大きさにもよりますが、ドーナッツの場合、赤十字マークがあらわれるところは
内側の円の中で、しかも、通常のセルの大きさだと、この場所は、ほとんどないと思われます。

じゃぁどうするのか・・・
いくつか思いつく方法もありますが、少し整理した上で、提案できそうなものがあれば
あらためてレスします。


	【70121】Re:また、質問させて下さい

じょにー

- 11/10/16(日) 17:33 -


	引用なし

	パスワード

UO3様kanabun様より最初に、ご提示下さった時にEXLECL2002上でチェックしましたが、２重丸でもちゃんと、選択出来て消えてました。その時のマウスポインタは、白抜の十字でしたけど、今回EXECL2007上では全方向矢印の十字です。EXECL2007上では、無理なのでしょうかねぇ、良い案が浮かんだら、是非御教授下さいね。


	【70122】Re:また、質問させて下さい

UO3 - 11/10/16(日) 17:37 -


	引用なし

	パスワード

▼じょにーさん：

思いつき部分が多いので実際の運用面でどうか・・・とは思いますが。

標準モジュールのAddShapeの最後、End Sub の直前に

ActiveSheet.Shapes(ActiveSheet.Shapes.Count).OnAction = "DelShapeX"

これをいれておきます。

で、以下のプロシジャを追加します。

Sub DelShapeX()
　　ActiveSheet.Shapes(Application.Caller).Delete
End Sub

図のあるセルをダブルクリックした際に、「運良く」セル領域にマウスポインターがあれば
現行のロジックが動いて図は削除されますし、図そのものにポインターがあれば
図に登録されたマクロとしてのDelShapeXで削除されます。

ただ・・・実際には図のダブルクリックではなく図のクリックで削除されます。
セルがそんなにおおきくない場合は、最初のクリックで消え、カーソルが下のセルに移り
２度目のクリックで、下のセルでダブルクリックイベントが発生し、そこにドーナッツが
作られるケースが多くなります。

ですから、この案でいくなら、運用ルールとしては
・図のないセルではダブルクリックで図を作成。
・図に対しては「クリック」で削除。
このようにされたほうがいいのかも。
（つまり、シートモジュールには是の作成コードのみを書き、削除部分は「削除」）

あぁ、本線テーマではないのですが、標準モジュールのプロシジャは
Public 記述がなくてもPublic扱いになっています。

また他のモジュールからPublicプロシジャにとぶ場合、Module1.プロシジャ名　といった
モジュール修飾は不要です。


	【70123】Re:また、質問させて下さい

じょにー

- 11/10/16(日) 17:50 -


	引用なし

	パスワード

U03様、いつも素早いレスをありがとうございます。早速、コードを追加して試した所「マクロ'DelShapeX'を実行できません。このブックでマクロが使用できないか、またはすべてのマクロが無効になっている可能性があります。」この様なメッセージが出てきました、私のやり方が、まずかったのでしょうか？


	【70124】Re:また、質問させて下さい

じょにー

- 11/10/16(日) 19:11 -


	引用なし

	パスワード

UO3様、申し訳ありません。先程は、ダメだったと言うレスを書いてしまいまいたが、バックグラウンドで、EXECL2002にて別作業を進行中だったので、ブックを開いたまま、チェックを行ったのでダメだった様です、今改めてチェックした所ダブルクリックで絵画、シングルクリックで消去と言う動作をいたしました。これで問題無いので、これで活かさせてもらいます、只ダブルクリックで絵画後図形を選択状態になっていたので、何所か一度別箇所をクリックしないと、図形のセルをクリック出来なかったので、Sheet1のイベントプロシージャ側のEnd Subの前にTarget.Offset(0,1).Selectをつけて、下に一つ選択をずらす動作を入れたら。特に問題無いですね。いつも、本当にありがとうございます。本当に助かっております。では、またのご指導を宜しくお願いいたします。


	【70203】また少し教えて下さい。

じょにー

- 11/10/19(水) 14:01 -


	引用なし

	パスワード

またしても、質問させてもらいます。
U03様のご提案をいただき、コードを修正して、試した所もの凄く良い出来になったので、これに手を加えて作ろうとした所
シートモジュールのダブルクリックイベントの場所に実際に図を描きた場所かどうか等の判定を行うコード等を追加して
実行した所Module1の[ActiveSheet.Shapes(ActiveSheet.Shapes.Count).OnAction = "DelShapeX]この部分で
「実行時エラー'1004':
アプリケーション定義またはオブジェクト定義のエラーです。」
と言うのが出ました。
イベントプロシージャの追加したコードは、シート１の構成が無いと、何のこっちゃとなるので、あえて記載していませんが。
コノエラーになる、原因としては、何が考えられるかご指摘くだされば、自分なりに考えてみたいと思いますので、
要因になりそうな事のヒントをいただけたら助かります。


	【70211】Re:また少し教えて下さい。

UO3 - 11/10/19(水) 19:42 -


	引用なし

	パスワード

▼じょにーさん：

>ActiveSheet.Shapes(ActiveSheet.Shapes.Count).OnAction = "DelShapeX"

さきほどから、いろいろエラーになる要素を作り出して実行していますが
すくなくとも、このコードで

>「実行時エラー'1004':
>アプリケーション定義またはオブジェクト定義のエラーです。

このエラーはでません。でたとしても別のエラーです。

やはり、シートモジュールのダブルクリックプロシジャと、そこからリンクする（と思われる）
標準モジュールのコードをアップいただかないと、これ以上は調査できませんねぇ。


	【70214】解りました

じょにー

- 11/10/19(水) 19:50 -


	引用なし

	パスワード

U03様、後日、改めてUPさせてもらいます。その時は、ご指導の程よろしくお願いします。


	【70215】Re:また少し教えて下さい。

kanabun - 11/10/19(水) 20:17 -


	引用なし

	パスワード

▼じょにーさん： >実行した所Module1の[ActiveSheet.Shapes(ActiveSheet.Shapes.Count).OnAction = "DelShapeX]この部分で >「実行時エラー'1004': >アプリケーション定義またはオブジェクト定義のエラーです。」 >と言うのが出ました。 >イベントプロシージャの追加したコードは、シート１の構成が無いと、何のこっちゃとなるので、あえて記載していませんが。【70021】に、図形に自分自身を消すマクロを登録しておいて、 ●図形のほうがクリックされたら、その図形を消すようする ●下のセルがダブルクリックされたら、図形を消すというコードを投稿してありますが、こちらは試されたんでしょうか？ > ---- > ◎があるセルをダブルクリックするのはセルの上にある図形が > 邪魔をしてダブルクリックしにくいことがあるので、 > ◎を描くとき、マクロを登録しておいて(◆追加1 の行)、 > > (1)消したい図形の下にあるセルがダブルクリックされたら、これまでどおり > 　　その図形の名前を指定して DelShapeプロシージャを呼び出す。 > (2)そうではなく、図形のほうがクリックされたら、 > 　　DelShape2プロシージャ(◆追加2 のほう)が自動で呼ばれて、その > 　　クリックされた図形の名前(Application.Caller) を指定して内部で > 　　DelShapeを呼び出す > '---- Module1 ------ > のほうは、こうしたほうが良かったかもしれません。 > > Public Sub AddShape(ByVal Target As Range) > 　　With Target > 　　　　.HorizontalAlignment = xlCenter > 　　　　With ActiveSheet.Shapes.AddShape(msoShapeDonut, _ > 　　　　　　.Left, .Top, .Width, .Height) > 　　　　　　.Fill.Transparency = 0# > 　　　　　　.Line.ForeColor.SchemeColor = 64 > 　　　　　　.Line.BackColor.RGB = RGB(255, 255, 255) > 　　　　　　.OnAction = "Module1.DelShape2"　'◆追加1 > 　　　　　　.TopLeftCell.Select > 　　　　End With > 　　End With > End Sub > > Public Sub DelShape(ShpName As String) > 　　With ActiveSheet.DrawingObjects(ShpName) > 　　　　.BottomRightCell.Select > 　　　　.Delete > 　　End With > End Sub > Public Sub DelShape2()　'◆追加2 > 　　DelShape Application.Caller > End Sub >


	【70217】はい、試しました。

じょにー

- 11/10/19(水) 20:30 -


	引用なし

	パスワード

kanabun様、お世話になっております。そちらの方のコードは試してみました。
EXECL2002上では問題無かったのですがEXECL2007上では、消す方がうまくいかず
ダブルクリックすると、図形の選択になるだけで、困ったので、その旨を投稿させてもらったら、U03様より、AddShapeプロシージャに１行追加と新たにDellShapex()のプロシージャの追加のご提案をいただきまして、ためした所、まさに、理想の結果になった事をご報告させてもらいましたが、その後、自分なりにコードに手を加え試した所、エラーになってしまって。原因が解らなかった為、再度投稿させてもらいました。U03様も言っておられましたが。手を加えた部分も含めコードを全ＵＰしないと、原因が、検討がつかないと言う事でしたので、後日、改めてＵＰさせてもらう予定です。


	【70218】Re:はい、試しました。

kanabun - 11/10/19(水) 20:40 -


	引用なし

	パスワード

▼じょにーさん： >kanabun様、お世話になっております。そちらの方のコードは試してみました。 >EXECL2002上では問題無かったのですがEXECL2007上では、消す方がうまくいかず >ダブルクリックすると、図形の選択になるだけで、困ったので、その旨を投稿 >させてもらったら、U03様より、AddShapeプロシージャに１行追加と新た >にDellShapex()のプロシージャの追加のご提案をいただきまして、ためした >所、まさに、理想の結果になった事をご報告させてもらいましたが、その後、 >自分なりにコードに手を加え試した所、エラーになってしまって。原因が解 >らなかった為、再度投稿させてもらいました。U03様も言っておられましたが。 >手を加えた部分も含めコードを全ＵＰしないと、原因が、検討がつかないと >言う事でしたので、後日、改めてＵＰさせてもらう予定です。そういうことでしたか。こちらも2002でしか検証してなかったので。了解です。 2002ですと、その図形に「マクロの登録」がしてあれば、図形の上にマウスをあてがうと、カーソルが手のひらアイコンに変わるので、そのままClickすればその図形は消えましたが... 2007だと、そうならない、ということですね。


	【70220】Re:はい、試しました。

kanabun - 11/10/19(水) 23:04 -


	引用なし

	パスワード

> 2007だと、そうならない、ということですね。こちらでも 2007で試してみましたが、 Excel2002と同じ挙動でした。（ちがうところといえば、ダブルクリックで作成される図形◎が　線が太くて、とても見にくいこと）　【70020】のコード '-----シートモジュール---- Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _ 　　　　　　　　　　　　　　　　　　　　Cancel As Boolean) Dim sh As Shape Dim c As Long 　　Cancel = True 　　For Each sh In ActiveSheet.Shapes 　　　　If Not Application.Intersect(Target, _ 　　　　　　　　　　sh.TopLeftCell) Is Nothing Then 　　　　　　Call Module1.DelShape(sh.Name) 　　　　　　Exit Sub 　　　　End If 　　Next sh 　　Call Module1.AddShape(Target) End Sub 　【70021】のコード '----Module1 標準モジュール ----- Public Sub AddShape(ByVal Target As Range) 　　With Target 　　　　.HorizontalAlignment = xlCenter 　　　　With ActiveSheet.Shapes.AddShape(msoShapeDonut, _ 　　　　　　.Left, .Top, .Width, .Height) 　　　　　　.Fill.Transparency = 0# 　　　　　　.Line.ForeColor.SchemeColor = 64 　　　　　　.Line.BackColor.RGB = RGB(255, 255, 255) 　　　　　　.OnAction = "Module1.DelShape2" 　　　　　　.TopLeftCell.Select 　　　　End With 　　End With End Sub Public Sub DelShape(ShpName As String) 　　With ActiveSheet.DrawingObjects(ShpName) 　　　　.BottomRightCell.Select 　　　　.Delete 　　End With End Sub Public Sub DelShape2() 　　DelShape Application.Caller End Sub どこかが、お使いのコードとちがうから違った挙動をしてるんだと思いますが。


	【70234】ありがとうございました。

じょにー

- 11/10/21(金) 8:06 -


	引用なし

	パスワード

kanabun様いつもお世話になっております。急遽、一月程海外出張に行く事になり
準備に追われて、レスが遅くなった事を、まずお詫びします。
私もEXECL2007で試した所◎の線が少し太く色が、青味がかかっていたので、変更しようと思い、EXECL2007でシェイプ絵画のマクロの記録を撮ろうと思い、行ってみましたが、記録が出来なかったので、その旨を【70103】にて質問させてもらったら、U03様よりレスをいただき。線の太さを0.25pt塗りつぶし無のコードをご提示下さったので、Module1のAddShapeのシェイプ絵画部分をご提示下さったコードに変更した所◎は見事な絵画をいたしましたが、次の消方で図形の選択になるだけで、消されなかったので、またその旨を質問させてもらった所、U03様よりコードの変更のアドバイスを受変更を行いました。それにより、EXECL2007上での絵画→消去の動作は
問題無く動きましたが。それらのコードに絵画→消去をする場所の判定をするコードを追加して（場所の判定は単体では、ちゃんと判定出来ていました。）その２つをダブルクリックイベントの中に盛込んで行った所、エラーが出た次第です。
一月程自宅を離れるので、レスはしばらく、お返しする事が出来なくなると思いますので、一旦、このスレッドは閉じさせてもらいます。また帰国した後、落ち着いたら、作成を始めようと思っておりますので、その時には、是非ともご指導の程よろしくお願いいたします。


	【70235】ありがとうございました。

じょにー

- 11/10/21(金) 8:42 -


	引用なし

	パスワード

U03様いつもお世話になっております。
【70234】で書いた様に急遽一月程、海外出張に行く事になりましたので、しばらく
EXECLに触る時間が出来ませんので、一旦このスレッドを閉じさせて下さい。
また帰国した後落ち着いて触れる事が出来る様になったら、再開しようと考えておりますので、その時には、是非にご指導の程をよろしくお願いいたします。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

2067 / 13645 ﾂﾘｰ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free