個人事業主の方必見!確定申告のお悩み解決

皆様おはこんばんちわ。
セル(Ex.B2,B3,B4)をダブルクリックする度に、そのセル内にオートシェイプを描画/削除したいのです。
描画は下記(で良いのかですが)で出来たのですが、削除がどうしてもわかりません。
-------------------------------------------------------------------------
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("B2:B4")) Is Nothing Then Exit Sub

With ActiveCell
With ActiveSheet.Shapes.AddShape _
(msoShapeOval, .Left, .Top, .Width, .Height)
.Fill.Visible = msoFalse
.Line.Weight = 1.75
.Line.ForeColor.SchemeColor = 0
End With
End With
End Sub
-------------------------------------------------------------------------
既に図形があるセルをダブルクリックで削除するにはどの様な方法があるのでしょうか。

バージョンはExcel2007です。
皆様よろしくご教示ください。

このQ&Aに関連する最新のQ&A

A 回答 (3件)

オートシェイプ描画時に自身を削除する(Wクリックでは無くクリックになってしまいますが)マクロを仕込む方法があります。

リンク先の#3ですが、コードが(おそらく実行時間も)短いのがメリットです。
http://oshiete.goo.ne.jp/qa/5496600.html
1.ダブルクリックでセル内に楕円を描く(ご質問には合わせておらず、以前回答したままです、OnActionのところにご注目下さい。)
これはシートモジュールに記述
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
With Target
.Parent.Shapes.AddShape(msoShapeOval, .Left, .Top, .Width, .Height).Select
End With
With Selection
.ShapeRange.Fill.Visible = msoFalse
.OnAction = "eraseShape"
End With
End Sub

2.消すときはダブルクリックではなく、クリックになってしまいますが、こちらは標準モジュールに記述してください。(Module1など)
Sub eraseShape()
ActiveSheet.Shapes(Application.Caller).Delete
End Sub

こちらは少々やりとりが長いですが、一般的なシート内の全図形をスキャンして、セル位置が合致したら削除する方法を含んでいます。(我田引水)
http://oshiete.goo.ne.jp/qa/8241405.html

この回答への補足

mitarashiさま
いつも斬新で美しいコーディング誠に有難う御座います♪
同様の質問を検索はしていたのですが、見つける事が出来ず質問してしまいました。
それなのに、丁寧に解説までして頂いて^^

セルに楕円(Aとします)がある状態で、他のセルをダブルクリック(Bとします)すると
楕円Aのサイズ?位置?が動いてしまいました。
楕円Bをクリックで消去すると楕円Aは元に戻ります。
これは、Excel2007だからなのでしょうか?
mitarashiさまの方でもご確認出来ますでしょうか?

補足日時:2014/12/01 20:29
    • good
    • 0
この回答へのお礼

mitarashiさま
お礼が遅れてしまいました。
希望以上のご提案ありがとうございました♪

オートシェイプがぴょこぴょこ動く件についてご報告です。
下記の通り、私のPCがおかしいのかも知れません...
・画面の表示倍率を大きく(130%~180%)して動作確認をしていました。
  →100%に戻してから拡大すると正しい位置に楕円が表示されている。(200%だとピコピコしない)
  →印刷プレビューすると正しい位置にあり、シートに戻ったら正しい位置に表示されている。
   (楕円が二重に表示されていても、操作後は1個になっている)

お騒がせ致しました<(_ _)>

お礼日時:2014/12/04 22:37

#2です。

過分なお言葉をいただき恐縮です。
既存の楕円がちょこっと動く現象は確認できませんでしたが(当方xl2010です)
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
の中に、
Cancel = True
を加える方が紛れが少ないと思います。
この場合、Wクリックによりセルが編集状態になるのをCancelする働きをします。
ご参考まで。
<参考>「VBA Cancel=true」で検索すると、多数見つかります
http://www.excel.studio-kazu.jp/kw/2009081222365 …
イベントのカスタマイズのコードは初めてみました...
http://www.ken3.org/vba/backno/vba060.html
フォームを閉じるボタンのキャンセル等に使いますね

この回答への補足

書き忘れ。。
OnActionについては、発想がすごいって事しか言えないです(^-^)

補足日時:2014/12/06 18:52
    • good
    • 0
この回答へのお礼

mitarashiさま
こんばんは。
質問のコードには、Cancel=Trueを消してしまっていたので色々と考察させていまいすみませんでした。
何をキャンセルするのかは明確には解っていませんでした。。。
以前、試しにfalseにしセルが編集出来た。。位で終わっていました。

>イベントのカスタマイズのコードは初めてみました...
おっしゃっている意味がわかりません(T_T)
昨夜も調べていましたがクラスモジュールでつまづいていて...
初めて見られたって事は、VBはかなーり深いものなのですね。

フォームを作った時、×の事は気にしていなかったり。。。
いつまでも質問者に徹します。

お礼日時:2014/12/06 18:45

以下のページを参考にしてみてください。



インストラクターのネタ帳
選択したセル範囲に含まれる図形を削除するマクロ
http://www.relief.jp/itnote/archives/018407.php
    • good
    • 0
この回答へのお礼

kkkkkmさま
早速のご回答ありがとうございました。
描画と削除を交互に行うのがポイントでしたが、参考になりました。

お礼日時:2014/12/01 20:06

このQ&Aに関連する人気のQ&A

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

このQ&Aを見た人が検索しているワード

このQ&Aと関連する良く見られている質問

Q指定範囲内で図形等を削除する方法は?

Windows、Xp。 Excel で、シート内に幅広くオートシェィプ等で描いたいろんな図形があるとします。これらの図形を、ある範囲をドラッグで指定して、その範囲内の図形だけを削除したいのですが、どうしたらよいか操作方法を教えてください。因みに、セル範囲を指定し ⇒ [編集] ⇒ 「ジャンプ」 ⇒ 「セル選択」 ⇒ 「オブジェクト」 ⇒ OK  と操作すると、シート内の全ての図形が対象になってしまい目的を達することができません。範囲の指定の仕方と指定するタイミングを教えてください。お願いします。

Aベストアンサー

Officeのバージョンが書いてありませんが、私のOffice2003のExcelでは…
図形描画ツールバー(表示されてなければ、メニューの[表示]→[ツールバー]→[図形描画]を選択して表示)の[図形の調整]の右側のマウスカーソルの形をした「オブジェクトの選択」ボタンをクリックする→選択モードになる。
マウスをドラッグして選択したい図形を囲み、削除(DELキーまたは図形上で右クリックして[削除]を選択)

ちなみに、Excelの質問なのですから、カテゴリはデジタルライフ→ソフトウェア→MS Officeの方が良かったですね。

QVBAマクロで、図形等のオブジェクトを選択(特定)する方法ってありますか

こんにちは。VBAマクロを少しかじっています。
顔写真付きの従業員の検索システムを作りました。名前を入力(選択)したら、データシートから職員コード、住所、電話番号などの情報を検索し検索画面に表示します。この際、別のシートに顔写真を貼り付けたもの(1セルに1枚。セルに従業員名を入力してある。)から、VLOOKUP関数を使ってセル照会することで、画像も同時に表示することができます。
別の職員に切り換えたり、クリアする場合の画像の処理は、削除用のシートを用意し、そこにセルごと移動し、終了時にシートごと削除する方法をとりました。(当然、確認用のダイアログボックスが表示されます。)
前置きが長くなりましたが、問題は、用済みの画像を選択するプロシージャがあれば、あえて削除用のシートを用意する必要はありません。セルの場合は、Rangeプロパティやcellsプロパティで特定できますが、画像などのオブジェクトをセル番地などを使って特定する方法ってあるのでしょうか。
因みに、画像の選択処理を、マクロ記録でプロシージャを作成したら、
ActiveSheet.Shapes("Picture 1").Select などとなります。
よろしくお願いします。

こんにちは。VBAマクロを少しかじっています。
顔写真付きの従業員の検索システムを作りました。名前を入力(選択)したら、データシートから職員コード、住所、電話番号などの情報を検索し検索画面に表示します。この際、別のシートに顔写真を貼り付けたもの(1セルに1枚。セルに従業員名を入力してある。)から、VLOOKUP関数を使ってセル照会することで、画像も同時に表示することができます。
別の職員に切り換えたり、クリアする場合の画像の処理は、削除用のシートを用意し、そこにセルごと移動し、終了時...続きを読む

Aベストアンサー

検索シートにシェイプが1つしかなければ
ActiveSheet.Shapes(1).Select
で選択
ActiveSheet.Shapes(1).Delete
で削除できます。

Qマクロでオートシェイプを表示したいのですが(泣)

マクロが理解できない初心者です。
エクセルで書類を作成しているのですが
「特定のセルに入力された文字列を
楕円のオートシェイプで囲む」といった要領で
分類する項目が大量にある書類を作成することになり
マクロの記録を使ってマクロを作成しようと試みたのですが
うまくいかず、困っています・・・
VBAなどで記入してマクロを作るということは
検索してわかったのですが
勉強する時間的余裕がありません・・・
どなたかご教授ください
おねがいします。


|新規|継続|といった項目のどちらかを分類するために
囲みたいセルをダブルクリックすると
楕円のオートシェイプで項目の文字列を囲むいう感じです。

ダブルクリックするとシェイプが表示され
さらにダブルクリックすると非表示になるといったマクロが
できないでしょうか?

Aベストアンサー

下記はセルをダブルクリックで楕円などが現れます。
シート単位。従って
シートタブ部で右クリック。コードの表示、をクリック。
出てきた画面に貼り付け。
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column = 1 Then 'A列ならば
lft = Target.Left + 2
tp = Target.Top + 2
hgt = Target.Height - 4
wdth = Target.Width - 4
'ActiveSheet.Shapes.AddShape(msoShapeOval, lft, tp, wdth, hgt).Select
ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangle, lft, tp, wdth, hgt).Select
Selection.ShapeRange.Fill.Transparency = 0.85
Target.HorizontalAlignment = xlCenter
End If
End Sub
シートのA列のセルでダブルクリックすると、そこで楕円や角丸四角
が出る。
上記コードでOvalの行かShapeRoundedRectangleのどちらか好きなほうを残し、他をコメント化してください。
A列限定の所は適当に列によって変える。A列からの順番の数で指定。
>勉強する時間的余裕がありません・・・
上記はマクロの記録を少々改造したもの。困っているのだろうから、やってみたが、上記ぐらいでもVBAを多少自由に出来るようになるには数年かかるほどやはり大変なことだよ。

下記はセルをダブルクリックで楕円などが現れます。
シート単位。従って
シートタブ部で右クリック。コードの表示、をクリック。
出てきた画面に貼り付け。
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column = 1 Then 'A列ならば
lft = Target.Left + 2
tp = Target.Top + 2
hgt = Target.Height - 4
wdth = Target.Width - 4
'ActiveSheet.Shapes.AddShape(msoShapeOval, lft, tp, wdth, hgt).Select
ActiveSheet.Shapes.AddShape(msoShapeRound...続きを読む

Qセルをクリック⇒そのセルに入力された文字を○で囲む

昨日質問させて頂いたのですが、会社のパソコンではネットは使えない為、マクロ以外の方法でと質問させて頂きましたが、こちらのサイトにはアクセス制限がかかっておらずコピーペースト可能でしたので再度質問させて頂きます。

ちなみにマクロは今回初めて使う為、完全初心者です。
マクロ入門サイトをいくつか読んでみましたが、よくわかりませんでした…

本題ですが、例えばエクセルのシートに

1.いちご
2.りんご
3.みかん

という選択肢があり、2番のりんごを選択したいとします。

『2』という数字の書かれたセルをダブルクリックすると、『2』という数字が○で囲まれるようにする事は出来ないものでしょうか?

会社で使うファイルなのですが、そのファイルにはこういった選択肢がいくつもあるので、シート上のどのセルをクリックしても、クリックした箇所が○で囲まれるようになればと思います。

コピーする為の式が貼り付けられているのを見かけますが、ああいった式を貼り付けた場合、囲む○の大きさや形状はどの段階で指定するのでしょうか?
(ちなみに今回使用したい○のサイズや形状は、どこのセルをクリックしても同じもので構いませんが、行からはみ出ない大きさの○に設定したいです)

一応私が調べたサイトでは、Altキーを押しながら[F11]キーを押す⇒標準モジュールの右側に式を貼り付けると書いてありましたが、その後どのようにその画面を終了するのか、またその後どのように実行するのかが書かれてありませんでした

会社のパソコンはEXCEL2013です。

マクロのコードを貼り付けて、実際に使ってみるまでの流れも教えて頂けませんでしょうか?
素人でもわかりやすいサイトがあればそちらでも構いません。

どうかよろしくお願い致します。

昨日質問させて頂いたのですが、会社のパソコンではネットは使えない為、マクロ以外の方法でと質問させて頂きましたが、こちらのサイトにはアクセス制限がかかっておらずコピーペースト可能でしたので再度質問させて頂きます。

ちなみにマクロは今回初めて使う為、完全初心者です。
マクロ入門サイトをいくつか読んでみましたが、よくわかりませんでした…

本題ですが、例えばエクセルのシートに

1.いちご
2.りんご
3.みかん

という選択肢があり、2番のりんごを選択したいとします。

『2』という数字...続きを読む

Aベストアンサー

このような要求は昔からよくありました。結構大変です。

それは、セルに入力された文字がどのようになっているか分からないからです。何もないシートに図形を挿入しようとすると、例えば、

  1.単一セルなのか結合セルなのか
  2.フォントの種類やフォントサイズは
  3.行高とセル内での上・中・下の位置は
  4.左・中・右揃えは
  5.どこに「○」を付ける
  6.セル内の文字は数値?文字列?
  7.表示した「○」を消したいことは?

くらいがはっきりすると制約付きでモジュールを作れます。



この質問の場合はほとんど未定の場合なわけで、次のようにします。

ア.実際に使用するシートに「○」を書いてください。

イ.解答したモジュールをそのシートのコードウィンドウに貼り付けて下さい。
(ALT-F11でVBE画面に移動し、メニューから、表示>プロジェクトエクスプローラーを選択し、Sheet1に「〇」があるならプロジェクトエクスプローラーのSheet1(Sheet1)をダブルクリックして表示された右の広い画面に貼り付けます。(Wordやメモ帳などと同じ感覚です))

これで終了です。当然ですが、ダブルクリックするたびに図形が現れたり消えたりします。「○」は図形のマルです。(別の形でも構いません)表示された図形を動かせないようにシートに保護をかけるべきかもしれません。このあたりは検討してください。

シートに帰ります。

この後、「〇」がうまく配置できたか検証します。「ア」で重要な点は、「○」の左上を該当セル内に納めることです。

うまく「○」が置けていれば、そのセルをダブルクリックすれば「○」は消えます。消えなければ位置を修正してください。必要な箇所に「○」を配置して、テストでダブルクリックして表示を全部消してしまいます。全部消えればテストと初期化が終了です。

最初に「○」を貼り付けてもらうことで、モジュール側で行うことが劇的に減少します。このようなシートを使うことの現実味も出てきます。

しかし、実務ではあまり使いません。この後、(アンケートのように)「○」を集計したいなどの追加要求が出てきたりします。「○」を付けて印刷したりしてその場限りで使うにはいいかもしれません。試してみてください。


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  Dim shp As Shape 'オートシェイプ
  For Each shp In Shapes
    With shp
      If Not (Application.Intersect( _
        Range(.TopLeftCell.Address), Target) Is Nothing) Then
        .Line.Visible = Not (.Line.Visible)
      End If
    End With
  Next
  Cancel = True
End Sub

このような要求は昔からよくありました。結構大変です。

それは、セルに入力された文字がどのようになっているか分からないからです。何もないシートに図形を挿入しようとすると、例えば、

  1.単一セルなのか結合セルなのか
  2.フォントの種類やフォントサイズは
  3.行高とセル内での上・中・下の位置は
  4.左・中・右揃えは
  5.どこに「○」を付ける
  6.セル内の文字は数値?文字列?
  7.表示した「○」を消したいことは?

くらいがはっきりすると制約付きでモジュールを作れます。



こ...続きを読む

Q画像を削除するマクロが知りたい

いつもお世話になっております。
別スレッドで「参照先ブックを開かずにコピーしたい」という投稿をしておりますが、その作業をしている同じブックでもう一つ実行したいことがあり、質問させていただきます。

現在、エクセルのマクロを使って、下記のようなプログラムを組んでいます。
(1)あるボタンを押すとフォームが出てくる
(2)フォームの中に画像のリストがあり、どれかを選んでクリックすると、ボタンのすぐ下のセルに画像が挿入される
VBAの構文でいうと以下のような内容です。

Private Sub フォーム1_Change()

If フォーム1.ListIndex = 0 Then
ChDir ThisWorkbook.Path
Workbooks.Open FileName:="BookA.xls"
Sheets("Sheet1").Select
Range("B2:H2").Copy
Windows("BookB").Activate
Sheets("Sheet2").Select
Range("B1").Select
ActiveSheet.Paste
Workbooks("BookA").Close
Windows("BookB").Activate
Else If フォーム1.ListIndex = 2 Then
・・・(3,4,5,と続く)
End If
End Sub

この要領で画像の貼付けを行い、一度挿入した画像が気に入らなくて別の画像に入れ替えたいという場合があるのですが、再度フォームボタンからリストを選択し直すと、新しく挿入した画像がその前に貼り付けられていた画像の上に重なる形で載ってきます。
この動作を繰り返すとどんどんブックの容量自体が重くなってしまうので、新しい画像を選択・挿入すると同時にその前に貼り付けられていた画像は削除される、というプログラムを組みたいです。
deleteとかclearとかいろんな構文を使って試してみましたが、どうしてもうまく行きません。
詳しい方のお知恵を拝借できれば幸いです。よろしくお願い致します。

いつもお世話になっております。
別スレッドで「参照先ブックを開かずにコピーしたい」という投稿をしておりますが、その作業をしている同じブックでもう一つ実行したいことがあり、質問させていただきます。

現在、エクセルのマクロを使って、下記のようなプログラムを組んでいます。
(1)あるボタンを押すとフォームが出てくる
(2)フォームの中に画像のリストがあり、どれかを選んでクリックすると、ボタンのすぐ下のセルに画像が挿入される
VBAの構文でいうと以下のような内容です。

Private Sub フォ...続きを読む

Aベストアンサー

エラー処理は省略してますが。。

Sub SampleProc()

  ' 例1)アクティブセルの場合
  Call DelShapes(ActiveCell)
  ' 例2)ユーザーが選択したセル選択で指定する場合
  Call DelShapes(Selection)
  ' 例3)Range で指定
  Call DelShapes(Range("A1:C10"))

End Sub


' // 指定した Range の範囲と重なる位置にある Shape を削除
Private Sub DelShapes(ByVal Target As Range)
  
  Dim Shp As Object
  Dim r  As Range

  For Each Shp In Target.Parent.Shapes
    Set r = Range(Shp.TopLeftCell, Shp.BottomRightCell)
    If Not Intersect(r, Target) Is Nothing Then
      Shp.Delete
    End If
    Set r = Nothing
  Next
  Set Target = Nothing

End Sub

エラー処理は省略してますが。。

Sub SampleProc()

  ' 例1)アクティブセルの場合
  Call DelShapes(ActiveCell)
  ' 例2)ユーザーが選択したセル選択で指定する場合
  Call DelShapes(Selection)
  ' 例3)Range で指定
  Call DelShapes(Range("A1:C10"))

End Sub


' // 指定した Range の範囲と重なる位置にある Shape を削除
Private Sub DelShapes(ByVal Target As Range)
  
  Dim Shp As Object
  Dim r  As Range

  For Each Shp In Target.Parent.Shape...続きを読む

QEXCEL VBA で現在開いているブックのファイル名を取得する方法

EXCEL2003 VBAで業務を簡素化するために、現在開いているブックのファイル名を取得する方法が分かりません。
作業手順をマクロを使って処理していますが、オリジナルのワークブックをファイル名を変えて保存し、以後、このワークブックを読み込んで使用しています。
このときのVBAは、オリジナルのファイル名を使っているため、ファイル名を変更するとエラーになり、以後の業務に使用できません。
常にファイル名を取得出来るVBAをどなたか、教えて下さい。

Aベストアンサー

>現在開いているブックのファイル名
 ちょっと曖昧な表現かなぁという気もいたしますが、VBAが書いてあるブックのブック名は
ThisWorkbook.Name
で、現在 "アクティブにして" 操作対象になっているブックの名前は
ActiveWorkbook.Name
ですね。

 しかし、
>VBAは、オリジナルのファイル名を使っているため、ファイル名を変更するとエラーになり
というような文脈からすると、
ThisWorkbook.Name
の方ですかね。

QExel VBA 別ブックから該当データを検索し、必要なデータを取得する方法について

部品表というブックがあります
A列に商品名、B列に商品番号が入力してあります。C列のコードは未入力です。
A列     B列     C列      
商品名  商品番号  コード
モータ  U-1325-L  
ホルダ  R-134256

また、コード一覧表という別のブックには、A列に商品番号と、B列にコードが、何千件も入力されています。

やりたいことは
部品表のC列のコード欄に、コード一覧表ブックから商品番号と一致するコードを貼り付けしたいのです。

部品表は、何百種類もありますので、関数ではなく、マクロで処理を希望します。

自分では、部品表の商品番号をコピーして、コード一覧表で検索し、検索結果の右隣のセル(B列のコード)の値を部品表のC列に貼り付ければよいかと思い、書いてみたんですが…

Sub 別ブックから貼り付ける()
  Dim 検索する As Long
Windows("部品表.xls").Activate
検索する = cells(i,2).Value
Windows("コード一覧表.xls").Activate
ActiveWindow.SmallScroll Down:=-3
Selection.AutoFilter Field:=3, Criteria1:="=検索する", Operator:= xlAnd

と、してみたものの、検索しても、その検索結果の隣のセルのコードをどうやって取得すればいいのかが、わかりませんでした。

基本事項は本で学びましたが、呪文のようなコードはよく理解できません。懸命にネットで検索して、訳して理解する努力をしてはいますが。

どうぞよろしくお願いします。

部品表というブックがあります
A列に商品名、B列に商品番号が入力してあります。C列のコードは未入力です。
A列     B列     C列      
商品名  商品番号  コード
モータ  U-1325-L  
ホルダ  R-134256

また、コード一覧表という別のブックには、A列に商品番号と、B列にコードが、何千件も入力されています。

やりたいことは
部品表のC列のコード欄に、コード一覧表ブックから商品番号と一致するコードを貼り付けしたいのです。

部品表は、何百種類もありますので、関数...続きを読む

Aベストアンサー

こんにちは。
とりあえず実用性も踏まえました。
メインの動作はワークシート関数のVLOOKUPをVBA上で使用していますので理解はしやすいかと思います。
また、質問文から察するに「部品表.xls」と「コード一覧表.xls」の両方を開いて処理されていますが「コード一覧表.xls」はプログラム内で開いて閉じているので実行するときは「コード一覧表.xls」は閉じて置いてください。
Option Explicit
Sub Sample()
 Application.ScreenUpdating = False
 Dim I As Long
 Dim xlBook
 Set xlBook = Workbooks.Open("C:\★★\コード一覧表.xls") '★要変更★
 I = 2
 Do While Range("A" & I).Value <> ""
  ThisWorkbook.Worksheets("Sheet1").Range("C" & I).Value = Application.VLookup(ThisWorkbook.Worksheets("Sheet1").Range("B" & I).Value, xlBook.Worksheets("Sheet1").Range("A2:B65535"), 2, 0)
  I = I + 1
 Loop
 xlBook.Close
 Application.ScreenUpdating = True
 MsgBox ("完了")
End Sub

こんにちは。
とりあえず実用性も踏まえました。
メインの動作はワークシート関数のVLOOKUPをVBA上で使用していますので理解はしやすいかと思います。
また、質問文から察するに「部品表.xls」と「コード一覧表.xls」の両方を開いて処理されていますが「コード一覧表.xls」はプログラム内で開いて閉じているので実行するときは「コード一覧表.xls」は閉じて置いてください。
Option Explicit
Sub Sample()
 Application.ScreenUpdating = False
 Dim I As Long
 Dim xlBook
 Set xlBook = Workbooks....続きを読む

QVBAのロジックでEXCEL上にShape図形があるかないかをチェック

VBAのロジックでEXCEL上にShape図形があるかないかをチェックするには

EXCEL2007-VBAを勉強中です。
EXCELシート上にShape図形があるかないかをチェックするには
どのように書くのでしょうか

どうぞ宜しくお願いします。

Aベストアンサー

図形にはTopLeftCell と BottomRightCell プロパティがあります。
左上隅
MsgBox ActiveSheet.Shapes(1).TopLeftCell.Address
右下隅
MsgBox ActiveSheet.Shapes(1).BottomRightCell.Address


こんな感じでどうでしょうか。

Dim i As Integer

For i = 1 To ActiveSheet.Shapes.Count
If ActiveSheet.Shapes(i).TopLeftCell.Address = "$C$10" Then
MsgBox "セル$C$10に図形を発見しました"
End If
Next i

ちょっとレベルが上がりますが、下記でkeithinさんの回答が参考になります。
エクセルで指定セル範囲内の画像・オートシェイプ・値をマクロを使って削除
http://qa.mapion.co.jp/qa5824633.html


>情報が少なくすみませんでした。
>セル指定を行い、指定したセルにShape図形があるかないかを調べる方法を
少ないというよりも、間違い、レベルだと思いますです。
本文から、捕捉に書かれた、真の意図、を推測することは私には無理です。
アップする前に、意図が第3者に伝わるかどうか、文章を推敲されていますか?
(別に怒っているわけではありませんよ。)

図形にはTopLeftCell と BottomRightCell プロパティがあります。
左上隅
MsgBox ActiveSheet.Shapes(1).TopLeftCell.Address
右下隅
MsgBox ActiveSheet.Shapes(1).BottomRightCell.Address


こんな感じでどうでしょうか。

Dim i As Integer

For i = 1 To ActiveSheet.Shapes.Count
If ActiveSheet.Shapes(i).TopLeftCell.Address = "$C$10" Then
MsgBox "セル$C$10に図形を発見しました"
End If
Next i

ちょっとレベルが上がりますが、下記でkeithinさんの回答...続きを読む

QVBA|楕円のリンクについて

いつもお世話になります。
エクセルは2010を使っています。

現在、エクセルで表を作成しています。
表内の一部分に「該当する」「該当しない」の2つの項目があり
どちらかに楕円を描かないといけません。
楕円は、「挿入」→「図形」から楕円を描いています。

また、表は3枚複写で、「シート1」「シート2」「シート3」に
それぞれ「該当する」「該当しない」の項目があります。

シート1の「該当する」に楕円を入れる場合、残りのシート2、シート3も「該当する」に楕円が必要になります。

シート1の「該当しない」に楕円を入れる場合、残りのシート2、シート3も「該当しない」に楕円が必要になります。

現在は、シート1、シート2,シート3の「該当する」「該当しない」両方にとりあえず楕円を入れています。
そして、「該当する」に楕円が必要な場合、シート1,シート2、シート3の「該当しない」の楕円を削除。
「該当しない」に楕円が必要な場合、シート1、シート2、シート3の「該当する」の楕円を削除――というふうにしています。

それ以外の、たとえば、「住所」や「名前」といった入力欄には、シート1に入力したら、シート2、シート3にもおなじ内容が入力されるようにリンクしています。

なので、今回の「該当する」「該当しない」の楕円の箇所の理想の状態は、最初は「該当する」「該当しない」どちらにも楕円が表示されていない状態で、「該当する」「該当しない」どちらかをクリック、もしくはダブルクリックすると、そこに楕円が表示されて、残りのシート2,シート3にも楕円が表示される――です。

このような動作をエクセルのVBAで可能でしょうか?

上記のような表で楕円を入れる場合、どのようにつくったら一番理想的なのか、皆様のお知恵をお借りしたいです。

どうか、よろしくお願いいたします。

いつもお世話になります。
エクセルは2010を使っています。

現在、エクセルで表を作成しています。
表内の一部分に「該当する」「該当しない」の2つの項目があり
どちらかに楕円を描かないといけません。
楕円は、「挿入」→「図形」から楕円を描いています。

また、表は3枚複写で、「シート1」「シート2」「シート3」に
それぞれ「該当する」「該当しない」の項目があります。

シート1の「該当する」に楕円を入れる場合、残りのシート2、シート3も「該当する」に楕円が必要になります。

シート1の「該...続きを読む

Aベストアンサー

理想的なんて言われると回答できませんが、徒然なるままに作成してみました。
楕円を描かせるのは簡単ですが、消したいという場合はやっかいです。
Sheet1のWクリックしたセルに楕円を描くと共に、左隣か右隣のセルに楕円があれば消してしまうというコードです。Sheet2,3についても同様に処理します。(Sheet1基準で)
実用には、イベントが動作するセルを制限する必要があるでしょう。興味を持たれたらご自分でお調べ下さい。
xl2010で試しています。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim myCell As Range
Dim shp As Shape

Cancel = True
If Target.Column > 1 Then
Set myCell = Target.Offset(0, -1)
If delOval(myCell) Then
delOval Sheets(2).Range(myCell.Address)
delOval Sheets(3).Range(myCell.Address)
End If
End If
If Target.Column < Me.Columns.Count Then
Set myCell = Target.Offset(0, 1)
If delOval(myCell) Then
delOval Sheets(2).Range(myCell.Address)
delOval Sheets(3).Range(myCell.Address)
End If
End If
addOval Target
addOval Sheets(2).Range(Target.Address)
addOval Sheets(3).Range(Target.Address)
End Sub

Private Sub addOval(targetRange As Range)
Dim myOval As Shape

With targetRange
Set myOval = .Parent.Shapes.AddShape(msoShapeOval, _
.Left + .Width * 0.1, .Top + .Height * 0.1, .Width * 0.8, .Height * 0.8)
End With
With myOval
.Fill.Visible = msoFalse
.Line.ForeColor.RGB = vbBlack
End With
End Sub

Private Function delOval(targetRange As Range) As Boolean
Dim shp As Shape

For Each shp In targetRange.Parent.Shapes
If Not Intersect(shp.TopLeftCell, targetRange) Is Nothing Then
shp.Delete
delOval = True
Exit Function
End If
Next shp
delOval = False
End Function

理想的なんて言われると回答できませんが、徒然なるままに作成してみました。
楕円を描かせるのは簡単ですが、消したいという場合はやっかいです。
Sheet1のWクリックしたセルに楕円を描くと共に、左隣か右隣のセルに楕円があれば消してしまうというコードです。Sheet2,3についても同様に処理します。(Sheet1基準で)
実用には、イベントが動作するセルを制限する必要があるでしょう。興味を持たれたらご自分でお調べ下さい。
xl2010で試しています。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As R...続きを読む

QエクセルVBA 図形の選択法は?

セル範囲をコピー
図としてペースト
ペーストされた図形を選択

記録マクロで書くと下記のようになります。
Sub Macro1()
Range("G2:K15").Select
Selection.Copy
Range("A1").Select
ActiveSheet.Pictures.Paste.Select
ActiveSheet.Shapes.Range(Array("Picture 1")).Select
End Sub

・場所を指定してペーストするのは、事前にselectする必要あるのでしょうか?
・挿入された図の名前がPicture1と分ってないと選択出来ません。他に方法あるのでしょうか?
図は複数あり、たった今ペーストした図形を選択したいのです。

参考になるURLあるいは書籍はないでしょうか?

Aベストアンサー

>挿入された図の名前がPicture1と分ってないと選択出来ません。他に方法あるのでしょうか?

Pasteする際に、Excelが勝手につけた名前を変数に保存して、その名前でSelectすることができます。

名前の保存は、こんな感じで。
MyPicName = ActiveSheet.Pictures.Paste.Name  ’Pasteと同時に、その名前を変数に代入します。


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング