Excel VBA質問箱 IV

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

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


12041 / 76734 ←次へ | 前へ→

【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

どこかが、お使いのコードとちがうから 違った挙動をしてるんだと
思いますが。
20 hits

【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 お礼

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