How can I delete a shape which starts with a certain string?
No need for a loop(?) There is only one "MyButton", but with different number after "MyButton".
worksheets("sheet1").Shapes("MyButton" & "*").Delete
You need to loop to check the names.
Dim shp As Shape
For Each shp In Worksheets("Sheet1").Shapes
If shp.Name Like "MyButton*" Then
shp.Delete
End If
Next shp
Related
I have pasted textboxes over charts.
I'm trying to change the font size within that textbox for all charts.
This is a picture of what I mean
Sub shapeFont()
Dim shp As Shape
For Each shp In ActiveSheet.Shapes
With shp.ShapeRange.TextFrame2.TextRange.Font
.Size = 30
End With
Next shp
End Sub
These textboxes seems to be embedded into ChartObjects. So you have to loop your ChartObjects instead. Then loop over its Shapes collection and only when you encounter a proper TextBox you should change it's font. Embedded textboxes can be inserted into a chart by selecting a chart and inserting a shape. From then, these shapes move with the chart.
For example:
Sub FindTextBoxes1()
Dim c As ChartObject
Dim s As Shape
For Each c In ActiveSheet.ChartObjects
For Each s In c.Chart.Shapes
If s.Type = msoTextBox Then
s.TextFrame2.TextRange.Font.Size = 30
End If
Next s
Next c
End Sub
Specify a Workbook and Worksheet variable for pinpointing better where you want this macro to operate (instead of an ugly ActiveSheet)
Inspiration from here
Whereas embedded textboxes are great to distinguish shapes you do want to change from the ones you don't want to change, you also don't need to actually select your textboxes first to be able to change your Font.Size in case you want to iterate over all non-embedded textboxes. Simply refer to the Characters within the TextRange. For example:
Sub FindTextBoxes2()
Dim s As Shape
For Each s In ActiveSheet.Shapes
If s.Type = msoTextBox Then
s.TextFrame2.TextRange.Characters.Font.Size = 30
End If
Next
End Sub
VBA is a strange language if you actually select it it is able to do it..
Sub shapeFont()
Dim shp As Shape
For Each shp In ActiveSheet.Shapes
shp.Select
With Selection.ShapeRange.TextFrame2.TextRange.Font
.Size = 30
End With
Next shp
End Sub
If chart object is present and you have separate textboxes this works:
Sub shapeFont()
Dim shp As Shape
For Each shp In ActiveSheet.Shapes
shp.Select
Debug.Print (shp.Type)
If shp.Type = msoTextBox Then
With Selection.ShapeRange.TextFrame2.TextRange.Font
.Size = 50
End With
End If
Next shp
End Sub
If you want to update the boxes on the chart the code provided by https://stackoverflow.com/users/9758194/jvdv will work
I would like to delete all the shapes from my sheet. They have the same ID.
I found two codes:
The first one:
Public Sub ActiveShapes()
Dim ShpObject As Variant
If TypeName(Application.Selection) = "Firestop" Then
Set ShpObject = Application.Selection
ShpObject.Delete
Else
Exit Sub
End If
End Sub
is not working. There are no errors, but also no reaction at all.
The second one:
Selecting a shape in Excel with VBA
Sub Firestopshapes()
ActiveSheet.Shapes("Firestop").Delete
End Sub
works, but remove only one by one element. In my event, all the elements have the "Firestop" ID. I would like to make them all deleted at once. How can I do that?
The issue is thet If TypeName(Application.Selection) = "Firestop" Then is never true. Have a look into the TypeName function does not return the name of the Application.Selection but instead it returs what type Application.Selection is. Here it probably returns Object because a shape is an object.
Actually names are unique. You cannot add 2 shapes with the same name. That is why ActiveSheet.Shapes("Firestop").Delete only deletes one shape.
There seems to be a bug that when you copy a named shape 2 shapes with the same name exist (which should not be possible). You can get around this by deleting that shape in a loop until you get an error (no shape with that name is left).
On Error Resume Next
Do
ActiveSheet.Shapes("Firestop").Delete
If Err.Number <> 0 Then Exit Do
Loop
On Error GoTo 0 'don't forget this statement after the loop
It is not recommended to use On Error Resume Next often. We recommend using it only when it is indispensable.
Sub test()
Dim shp As Shape
Dim Ws As Worksheet
Set Ws = ActiveSheet
For Each shp In Ws.Shapes
If shp.Name = "Firestop" Then
shp.Delete
End If
Next shp
End Sub
I have an excel that has 1 column with picture in each cell, that picture determines something but i would like to change it to 1 instead. There is only 1 picture, and to my exact, the column is J;Name =PO history/release documentation . Can someone help me to do it with VBA Thank you!
Public Sub Replace_Picture()
Const Replace_Text = "OK"
Dim shp as Shape
For Each shp In ActiveSheet.Shapes
If shp.TopLeftCell.Address = shp.BottomRightCell.Address Then
shp.TopLeftCell.Value = Replace_Text
shp.Delete
End If
Next
Set shp = Nothing
End Sub
I tried the above code but its not working and const replace_text is in red.
I just want to change those cells with the picture to "1", while those blanks will be leave it to be.
I guess you want to delete the PO history shapes from SAP.
you may have a try by below VBA code.
Another way is you may 'Copy+Paste' data from SAP directly instead of 'Export to Excel'
Sub Replace_Shapes()
Dim Shp As Shape
Dim Shp_Address
For Each Shp In ActiveSheet.Shapes
If Shp.Type = msoPicture Then
'Identify the address of Shape by TopLeft
Shp_Address = Shp.TopLeftCell.Address
Range(Shp_Address) = 1
Shp.Delete
End If Next
End Sub
A piece of my code (to delete all shapes in the sheet) suddenly started to throw an error
"Object does not support this property or method"
and highlights the row If Shp.Type = msoAutoShape Then This is a part of a big code I continuously update, but the code below is not a part of any cycle, IF, etc. What could be a reason?
Dim Shp As Shape
For Each Shp In ActWS.Shapes
If Shp.Type = msoAutoShape Then Shp.Delete
Next Shp
Your code works by me. Probably there is something with the shapes, that you are using. Can you run this:
Public Sub ale()
Dim Shp As Shape
For Each Shp In ActiveSheet.Shapes
If Shp.Type = msoAutoShape Then
Debug.Print Shp.Name
Shp.Delete
End If
Next Shp
End Sub
And share what is the last result from the Immediate window before the error comes? Also, can you confirm on which line of the new code the error comes?
This is what i try to do. When i click on one button, the autoshape above is copied in the A8:F12 rectangle.
The code for the 1st button(recorded macro):
Sub addTextbox1()
Range("A2:C3").Select
Range("C2").Activate
Selection.Copy
Range("B9").Select
ActiveSheet.Paste
End Sub
My problem is i want to make a button which can erase the autoshape in the A8:F12 range. I found this which delete all autoshapes in the worksheet:
Sub DeleteShapes()
Dim Shp As Shape
For Each Shp In ActiveSheet.Shapes
Shp.Delete
Next Shp
End Sub
or delete an autoshape by its name (don't work in my case, new autoshapes are generated so i don't know their name)
I know it's fast to click on the shape and press 'delete' but by curiosity i wanted to know if it's possible to do it in VBA
One way below is to test whether the top left cell of the shape lies in your deletion range:
Sub DeleteShapes()
Dim Shp As Shape
For Each Shp In ActiveSheet.Shapes
If Not Application.Intersect(Shp.TopLeftCell, ActiveSheet.Range("A8:F12")) Is Nothing Then Shp.Delete
Next Shp
End Sub