Hi all,
I am trying to make a macro to find and delete several artistic text blocks regarding of their position and fill color.
In fact I want to delete all black artistic text within an area with known coordinates (x to x+100 and y to y+40).
my code do not work:
Dim sr3 As ShapeRange Set sr3 = ActivePage.Shapes.FindShapes( _ Query:="@type ='text:artistic' and @left > {x mm} > x and @right < {(x+100) mm})")
sr3.Delete
Thank you very much
This should delete artistic text shapes that are completely within the rectangular area:
Sub delete_completely_within() Dim dblX As Double Dim dblY As Double ActivePage.Shapes.FindShapes(Query:="@type ='text:artistic' and @left > {" & dblX & " mm} and @right < ({ " & dblX & " mm} +{100 mm}) and @bottom > {" & dblY & " mm} and @top < ({ " & dblY & " mm} +{40 mm})").Delete End Sub
This should delete artistic text shapes that are completely within or partially within the rectangular area:
Sub delete_completely_within_or_partially_within() Dim dblX As Double Dim dblY As Double ActivePage.Shapes.FindShapes(Query:="@type ='text:artistic' and @right > {" & dblX & " mm} and @left < ({ " & dblX & " mm} +{100 mm}) and @top > {" & dblY & " mm} and @bottom < ({ " & dblY & " mm} +{40 mm})").Delete End Sub
In both cases, I haven't set values for dblX and dblY, so they are both zero. In this video, the location 0,0 is the lower left hand corner of the page. I have drawn a 100 mm x 40 mm rectangle there for reference.
VIDEO: Delete text using rectangular area
.
Eskimo,
I changed all the "mm" to "in" to get it to work for me but each one does the same thing. Deletes all text from the entire page instead of just the rectangle area.
What page size are you using?
broad sheet (18 x 24)
If you change from millimeters to inches, then are you telling it delete everything within a 40 inch wide x 100 inch tall area, with the lower left hand corner of that area at the lower left hand corner of the page?