Excel VBA質問箱 IV

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

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


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

【17594】図形描画 かっちゃん 04/9/3(金) 6:17 質問[未読]
【17595】Re:図形描画 ichinose 04/9/3(金) 6:53 発言[未読]
【17597】Re:図形描画 かみちゃん 04/9/3(金) 7:22 回答[未読]

【17594】図形描画
質問  かっちゃん E-MAIL  - 04/9/3(金) 6:17 -

引用なし
パスワード
    いつも利用させていただいています。適切なアドバイスありがとうございます。

 今回は「図形描画」の件で質問させていただきます。
シート上で、直線を引いたりそれを消したりしていると、その直線は「直線96」とか「直線102」とかになっています。シート上に2本しかないのに、これまでの履歴が残っているのです。今は
 For J = 50 To 200
  DelLine = "Line " & J
  ActiveSheet.Shapes(DelLine).Select
  Selection.Delete
 Next J
で消していますが、使用するにつれてFor分の範囲を大きくしなければなりません。
それで、
 1 現在使用している直線の番号(直線96であれば96のこと)がわかる方法。
 2 直線を引くとき、番号が1(または0)から始まるように、リセットする方法。
 3 または、もっと良い方法
が、ありましたらお教えください。
よろしくお願いいたします。

【17595】Re:図形描画
発言  ichinose  - 04/9/3(金) 6:53 -

引用なし
パスワード
   ▼かっちゃん さん:
おはようございます。

> いつも利用させていただいています。適切なアドバイスありがとうございます。
>
> 今回は「図形描画」の件で質問させていただきます。
>シート上で、直線を引いたりそれを消したりしていると、その直線は「直線96」とか「直線102」とかになっています。シート上に2本しかないのに、これまでの履歴が残っているのです。今は
> For J = 50 To 200
>  DelLine = "Line " & J
>  ActiveSheet.Shapes(DelLine).Select
>  Selection.Delete
> Next J
>で消していますが、使用するにつれてFor分の範囲を大きくしなければなりません。
>それで、
> 1 現在使用している直線の番号(直線96であれば96のこと)がわかる方法。
> 2 直線を引くとき、番号が1(または0)から始まるように、リセットする方法。
> 3 または、もっと良い方法
>が、ありましたらお教えください。
>よろしくお願いいたします。
アクティブシート上に引いてあるラインを削除すればよい
というのであれば、

  ActiveSheet.Lines.Delete

で名前を意識せずにすみますが、意味が違いますか?

【17597】Re:図形描画
回答  かみちゃん  - 04/9/3(金) 7:22 -

引用なし
パスワード
   こんにちは。かみちゃん です。

> 1 現在使用している直線の番号(直線96であれば96のこと)がわかる方法。

図形をひとつだけ選択して下記マクロを実行してみてください。
もっといい方法があるかわかりませんが・・・
Sub Macro1()
 If VarType(Selection) = vbObject Then
  MsgBox "名前は " & Selection.Name & vbCrLf & _
       "番号は " & Replace(Selection.Name, TypeName(Selection) & " ", "")
 Else
  MsgBox "オブジェクトが選択されていません", vbCritical
 End If
End Sub

> 2 直線を引くとき、番号が1(または0)から始まるように、リセットする方法。
> 3 または、もっと良い方法

すでにichinoseさんからもコメントがついていますが別解ということで。

'選択したセル範囲内の特定の種類の図形だけを削除する
'参考URL
' http://park11.wakwak.com/~miko/Excel_Note/17-03_zukei.htm#17-03-47
Sub Macro1()
 Dim myShp As Shape
 Dim myR As Range, SR As Range
 On Error Resume Next
 Set myR = Selection
' 特定のセル範囲であれば次のように記述
' Set myR = Range("A1:D50")
 If Err.Number <> 0 Then Exit Sub
 On Error GoTo 0
 For Each myShp In ActiveSheet.Shapes
  Set SR = Range(myShp.TopLeftCell, myShp.BottomRightCell)
  If Not Intersect(SR, myR) Is Nothing Then
   '選択範囲内に「完全に含まれる」場合は削除する場合は次のIfステートメントで制御
   '選択範囲内と「部分的に重なる」場合も削除する場合は次のIfステートメントは不要
   If Intersect(SR, myR).Cells.Count = SR.Cells.Count Then
    '直線(msoLine)の場合削除する
    If myShp.Type = msoLine Then myShp.Delete
   End If
  End If
  Set SR = Nothing
 Next
 Set myR = Nothing
End Sub

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