[[20080108110410]]　『オートシェイプ削除』（YAMADA）　ページの最後に飛ぶ

『オートシェイプ削除』（YAMADA）

 オートシェイプで直線をH:J列に複数箇所引いていますが、
 A、B列にもオートシェイプで直線を引いています。
 H:J列のオートシェイプの直線だけを削除するにはどうすればいいですか？
 教えてください。

 下記は、過去ログから
  Sub 自由直線()
    With Range("H1：J2")
         x1 = .Left
         x2 = .Top
         x3 = .Width
         x4 = .Height
    End With
     ActiveSheet.Shapes.AddLine(x1, x2, x1 + x3, x2 + x4).Select
  End Sub

 十分な検証はしていませんが、こんな感じでどうでしょうか。(ROUGE)
'----
Sub test()
Dim sp As Shape
For Each sp In ActiveSheet.Shapes
    If sp.Type = 9 Then
        sp.Select
        With Selection.ShapeRange.Line
            If (.BeginArrowheadStyle = 1) * (.EndArrowheadStyle = 1) Then
                If Intersect(Range(sp.TopLeftCell, sp.BottomRightCell), _
                    Range("A:G,K:IV")) Is Nothing Then sp.Delete
            End If
        End With
    End If
Next
End Sub

大変遅くなりました。

 『自由直線()』を実行して『test()』実行しても消えなかったので
 範囲を広げたら消えました。
    Range("A:G,K:IV") → Range("A:F,Ｌ:IV")) 
 有難う御座いました。
                        （YAMADA）

解決後ですが、こんな方法も

Sub test()

    Dim rng As Range
    Set rng = Range("h:j")
    Dim sp As Object
    For Each sp In ActiveSheet.Lines
        With sp
        If .ArrowHeadStyle = -4142 Then
            If .Left >= rng.Left And _
               .Left + .Width <= rng.Left + rng.Width Then
               sp.Delete
               End If
            End If
        End With
       Next
End Sub

 どなたかわかりませんが、有難う御座いました。
 上記でｏｋになりました。

                        （YAMADA）

コメント返信：

[ 一覧(最新更新順) ]

[[20080108110410]] 『オートシェイプ削除』（YAMADA） ページの最後に飛ぶ

[[20080108110410]]　『オートシェイプ削除』（YAMADA）　ページの最後に飛ぶ