Excel VBA質問箱 IV

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

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


5941 / 13646 ツリー ←次へ | 前へ→

【48071】オートシェイプの直線全消去 初心者 07/4/2(月) 19:48 質問[未読]
【48072】Re:オートシェイプの直線全消去 ぱっせんじゃー 07/4/2(月) 19:56 発言[未読]
【48075】Re:オートシェイプの直線全消去 ぱっせんじゃー 07/4/2(月) 19:58 発言[未読]
【48073】Re:オートシェイプの直線全消去 ichinose 07/4/2(月) 19:56 発言[未読]
【48076】Re:オートシェイプの直線全消去 初心者 07/4/2(月) 20:10 お礼[未読]
【48077】Re:オートシェイプの直線全消去 初心者 07/4/2(月) 20:30 お礼[未読]
【48078】Re:オートシェイプの直線全消去 ichinose 07/4/2(月) 20:35 発言[未読]
【48079】Re:オートシェイプの直線全消去 初心者 07/4/2(月) 20:46 お礼[未読]
【48080】Re:オートシェイプの直線全消去 ぱっせんじゃー 07/4/2(月) 20:54 発言[未読]
【48081】Re:オートシェイプの直線全消去 初心者 07/4/2(月) 21:01 質問[未読]
【48083】Re:オートシェイプの直線全消去 りん 07/4/2(月) 21:52 回答[未読]
【48085】Re:オートシェイプの直線全消去 ichinose 07/4/2(月) 21:55 発言[未読]
【48086】Re:オートシェイプの直線全消去 初心者 07/4/2(月) 22:07 お礼[未読]

【48071】オートシェイプの直線全消去
質問  初心者  - 07/4/2(月) 19:48 -

引用なし
パスワード
   こんばんわ。
また教えて頂きたいのですが、シート内にある複数のオートシェイプ(直線のみ)を消したいのですが教えて下さい。
下記の方法だと、全部を選択した上に消すことすら出来ません・・・。
初歩以下的な事で、申し訳ないのですがご教授下さい。
宜しくお願いします。


Sub 直線全消去()
  Set ws = Application.ActiveSheet
    With ws
      .Shapes.SelectAll.Delete
  End With
End Sub

【48072】Re:オートシェイプの直線全消去
発言  ぱっせんじゃー  - 07/4/2(月) 19:56 -

引用なし
パスワード
   こんな方法でいかがでしょう?

  Dim sen As Line
  For Each sen In ActiveSheet.Lines
   If sen.ShapeRange.Line.EndArrowheadStyle = 1 Then sen.Delete
  Next

【48073】Re:オートシェイプの直線全消去
発言  ichinose  - 07/4/2(月) 19:56 -

引用なし
パスワード
   ▼初心者 さん:
こんばんは。

>また教えて頂きたいのですが、シート内にある複数のオートシェイプ(直線のみ)を消したいのですが教えて下さい。
>下記の方法だと、全部を選択した上に消すことすら出来ません・・・。
>初歩以下的な事で、申し訳ないのですがご教授下さい。
>宜しくお願いします。
>
>
>Sub 直線全消去()
>  Set ws = Application.ActiveSheet
>    With ws
>      .Shapes.SelectAll.Delete
>  End With
>End Sub
  ActiveSheet.Lines.Delete

これで試してみてください

【48075】Re:オートシェイプの直線全消去
発言  ぱっせんじゃー  - 07/4/2(月) 19:58 -

引用なし
パスワード
   ありゃりゃ、私のコードには、余計なものがくっついてました。
失礼しました。

【48076】Re:オートシェイプの直線全消去
お礼  初心者  - 07/4/2(月) 20:10 -

引用なし
パスワード
   ぱっせんじゃー さん ichinose さん こんばんわ。
早速の返答ありがとうございます。
直線は思い通りに消せたのですが、フリーフォームと名前の直線が消えてくれませんでした。直線とフリーフォームは、違う図形なのでしょうか。何度もすみませんが宜しくお願いします。

【48077】Re:オートシェイプの直線全消去
お礼  初心者  - 07/4/2(月) 20:30 -

引用なし
パスワード
   すみません、打ち間違いで意味不明になっていました。

>直線は思い通りに消せたのですが、フリーフォームと言う名前の直線が消えてくれませんでした。

です。すみませんが宜しくお願いします。

【48078】Re:オートシェイプの直線全消去
発言  ichinose  - 07/4/2(月) 20:35 -

引用なし
パスワード
   >
>>直線は思い通りに消せたのですが、フリーフォームと言う名前の直線が消えてくれませんでした。
>
>です。すみませんが宜しくお願いします。
    ActiveSheet.Drawings.Delete

これも追加してみては?

【48079】Re:オートシェイプの直線全消去
お礼  初心者  - 07/4/2(月) 20:46 -

引用なし
パスワード
   ▼ichinose さん
返信ありがとうございます。ご迷惑をおかけします。
追加してみたのですが、削除できませんでした。すみません。
他に方法がないか探してみます。何か別の方法があれば、ご教授下さい。
宜しくお願いします。

【48080】Re:オートシェイプの直線全消去
発言  ぱっせんじゃー  - 07/4/2(月) 20:54 -

引用なし
パスワード
   >ActiveSheet.Drawings.Delete

↑でフリーフォームで描いたシェイプは消えましたよ。
当方XLS:2002 WIN:XP-SP

【48081】Re:オートシェイプの直線全消去
質問  初心者  - 07/4/2(月) 21:01 -

引用なし
パスワード
   そう言えば、パソコンの情報を伝えてませんでした・・・。
エクセルはExcel2000で、パソコンは、XP-SP2です。
Excel2000だと対応していないとかありますか?

【48083】Re:オートシェイプの直線全消去
回答  りん E-MAIL  - 07/4/2(月) 21:52 -

引用なし
パスワード
   初心者 さん、こんばんわ。

>そう言えば、パソコンの情報を伝えてませんでした・・・。
>エクセルはExcel2000で、パソコンは、XP-SP2です。
>Excel2000だと対応していないとかありますか?

>ActiveSheet.Drawings.Delete

WinXP & XL2003で試したところ、「フリーフォーム」「フリーハンド」でひいたものは消えましたが、「曲線」で引いたものは消えませんでした(名前にはフリーフォームとついていて、種類もmsoFreeformなのに不思議)。。

ループしてチェックする方が確実みたいです。

Sub test()
  Dim sh As Shape
  For Each sh In ActiveSheet.Shapes
   Select Case sh.Type
     Case msoLine, msoFreeform
      sh.Delete
   End Select
  Next
End Sub
こんな感じです。

コネクタとかオートシェイプのカッコとかを使ってたらまたそれもAutoShapeTypeとかで判定する必要があります。

【48085】Re:オートシェイプの直線全消去
発言  ichinose  - 07/4/2(月) 21:55 -

引用なし
パスワード
   こんばんは。

>WinXP & XLXPで試したところ、「フリーフォーム」「フリーハンド」でひいたものは消えましたが、「曲線」で引いたものは消えませんでした(名前にはフリーフォームとついていて、種類もmsoFreeformなのに不思議)。。

本当ですね!!
でも、
Drawing.Delete

で削除できない図形を選択した状態で、

Typename(selection)

を実行すると、Rectangle と表示されます。

だからって、

ActiveSheet.Rectangles.Delete

では、削除できませんし・・・。
>
>ループしてチェックする方が確実みたいです

そうみたいですね!!

【48086】Re:オートシェイプの直線全消去
お礼  初心者  - 07/4/2(月) 22:07 -

引用なし
パスワード
   りん さん こんばんわ。
何度もお世話になります。無事削除する事ができました。
本当にありがとうございます。

ご協力頂きました みなさま 本当にありがとうございます。

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