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
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
I have a file that someone made and I was tasked with simply adding an autoupdater function that updates the cell next to the dropdown menu.
The way the dropdown menu is created is by going to data validation and selecting list and make list in cell. The values are read from elsewhere.
Now, what I tried was to loop over all shapes like this:
Dim dd As DropDown
Dim i As Integer
Debug.Print Sheet1.DropDowns.Count
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
Dim s As Shape
For Each s In ws.Shapes
Debug.Print CStr(s.Type)
Next
Next
End Sub
This prints the following:4 is a comment, 8 is a control form
444444444444444444444444444
8
So even though I have many drop down menus none come out when I loop over them.
I wanted to make it so that anyone can add a dropdown box and my code would attach an OnAction Sub that fills in the cell next to the dropdown box so the user can add as many boxes they want, but they have to only remember to keep the cell next to it, to the right for example, empty as it will be overridden.
Dim sh As Shape
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
For Each sh In ws.Shapes
If sh.Type = msoFormControl Then
If sh.FormControlType = xlListBox Then
sh.OLEFormat.Object.OnAction = "UpdateLBCell"
End If
End If
Next
Next
The original code above causes an object error on the innermost line.
Am I just stupid or is it not possible to loop over these dropdown boxes?
If it is impossible, can I make some other dropdown single select boxes that fit inside a cell? Combobox I tried, but they lie on top and dont match.
Any insight in alternative ways to do this is very appreciated as well.
I put a list validation on a few cells, then ran this code
Sub Test()
Dim dd As DropDown
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
Dim s As Shape
For Each s In ws.Shapes
Debug.Print CStr(s.Type), s.Top, s.Left
s.Visible = msoCTrue '<<<<
Next
Next
End Sub
Before and after (yellow cells have data validation):
So it seems as though if you have a "list" data validation set up, Excel manages a single (normally invisible and empty) drop-down which is typically positioned at the current active cell. It's only made visible when that's also one of the cells with validation set up.
EDIT: here's an example of how you could handle updates to cells with drop-down DV lists in a generic way -
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
On Error GoTo haveError
Application.EnableEvents = False
For Each c In Target.Cells
If HasDVList(c) Then
c.Offset(0, 1) = Now
End If
Next c
haveError:
Application.EnableEvents = True
End Sub
'does a cell have DV list?
Function HasDVList(rng As Range)
Dim v
On Error Resume Next
v = rng.Cells(1).Validation.Type
On Error GoTo 0
HasDVList = (v = 3)
End Function
The Shape should be Visible, whether the cell is "clicked-on" or not. I put a single DV dropdown on a sheet and ran:
Sub ShapeLister()
Dim s As Shape
For Each s In ActiveSheet.Shapes
MsgBox s.Type & vbCrLf & s.Name
Next s
End Sub
and got:
Try this on a fresh worksheet and tell us what you see.
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?