Hy, I have an excel workbook consisting an Excel Sheet which contains images, shapes, arrows and many more shapes. The structure of the sheet looks like this.
In the above picture, I circle all the textboxes, arrows, Ovels, shapes which I want to delete. I have written a code to delete text boxes which are checking the existence of textboxes and if found delete them. In the other hand, if not exist show pop-up that text-box, does not exist. The code is as under.
Sub resetall()
Dim ws As Worksheet
Dim arow As Shapes
Dim txtbox As TextBox
Set ws = ActiveSheet
If ws.TextBoxes.Count < 0 Then
MsgBox "No Text Box Exist."
Exit Sub
End If
ws.TextBoxes.Delete
MsgBox "Text Box has been deleted successfully."
End Sub
This code is working fine, but I could not find the code for Arrows, and Oval Shapes, and Circles. Please check my code and guide me. I tried to use the shapes. Oval reference from the library but could not succeed. Please guide me. Thank you.
https://www.thespreadsheetguru.com/the-code-vault/vba-delete-all-shapes
Sub DeleteAllShapes()
'PURPOSE: Remove All Shape Objects From The Active Worksheet
'SOURCE: www.TheSpreadsheetGuru.com/the-code-vault
Dim shp As Shape
For Each shp In ActiveSheet.Shapes
shp.Delete
Next shp
End Sub
Optionally, add a test inside the loop for a specific type from msoShapeType
Try the next code, please:
Sub DeleteallShapesExceptRect()
Dim ws As Worksheet, s As Shape, boolRect As Boolean
Set ws = ActiveSheet
For Each s In ws.Shapes
If s.Type = msoAutoShape Then
If s.AutoShapeType = msoShapeRectangle Then
boolRect = True
End If
End If
If Not boolRect Then s.Delete
boolRect = False
Next
The next variant excepts any Rectangle shape type:
Sub DeleteallShapesExceptAllRect()
Dim ws As Worksheet, s As Shape, boolRect As Boolean
Set ws = ActiveSheet
For Each s In ws.Shapes
If s.Type = msoAutoShape Then
If s.AutoShapeType = msoShapeRectangle Or _
msoShapeRoundedRectangle Or msoShapeRound1Rectangle Or _
msoShapeSnip2DiagRectangle Then
boolRect = True
End If
End If
If Not boolRect Then s.Delete
boolRect = False
Next
End Sub
The following variant deletes all shapes from a specific range:
Sub DeleteAllShapesOnRange()
Dim ws As Worksheet, s As Shape, rngDel As Range
Set ws = ActiveSheet: Set rngDel = ws.Range("A1:W6")
For Each s In ws.Shapes
If Not Intersect(rngDel, s.TopLeftCell) Is Nothing Then
s.Delete
End If
Next
End Sub
And the next one deletes all shapes which are Not on the specific range:
Sub DeleteAllShapesNotOnRange()
Dim ws As Worksheet, s As Shape, rngNoDel As Range, boolFound As Boolean
Set ws = ActiveSheet: Set rngNoDel = ws.Range("A1:W6")
For Each s In ws.Shapes
If Not Intersect(rngNoDel, s.TopLeftCell) Is Nothing Then
boolFound = True
End If
If Not boolFound Then s.Delete
Next
End Sub
And finally, a version deleting all shapes not having text:
Sub DeleteAllShapesNotHavingText()
Dim ws As Worksheet, s As Shape, boolFound As Boolean
Set ws = ActiveSheet
For Each s In ws.Shapes
If Not Len(s.TextFrame2.TextRange.Text) = 0 Then
boolFound = True
End If
If Not boolFound Then s.Delete
Next
End Sub
Note: Each such a code is able to ask for permission before deletion, but it will not make big difference between the manual deletion and the one done in code... If you insist to have such a condition, please specify which of the above versions to be adapted.
Anyhow, the next Sub returns (in Immediate Window) all (mentioned) shapes type. You can change their names. The following code check their real type, which is returned like Long:
Sub EnumerateShapesType()
Dim ws As Worksheet, s As Shape, boolRect As Boolean, arrS As Variant, arrEl As Variant, El As Variant
arrS = Split("Rectangle|1,Round Rectangle|5,Oval|9,Right Arrow|33,Down Arrow|36", ",")
Set ws = ActiveSheet
For Each s In ws.Shapes
If s.Type = msoAutoShape Then
For Each El In arrS
If s.AutoShapeType = Split(El, "|")(1) Then
Debug.Print s.Name, Split(El, "|")(0): Exit For
End If
Next
End If
Next
End Sub
Office 365 answer:
Go to the Home tab
Go to Find & Select
Go to Selection Pane
You now have the names of the shapes in your worksheet.
As an example, you could use ActiveSheet.Shapes.Range(Array("Straight Arrow Connector 1")).Delete to remove a single item.
Working on a macro that will go to the first sheet. I was using:
Sub GoToFirstSheet()
On Error Resume Next
Sheets(1).Select
End Sub
However, if sheet 1 is hidden, this wont work. How can I incorporate a way to go to the first sheet that isn't hidden?
Something like this?
Option Explicit
Sub GoToFirstSheet()
Dim i As Long
For i = 1 To ThisWorkbook.Sheets.Count
On Error Resume Next
Sheets(i).Activate
If Err.Number = 0 Then Exit For
Next i
End Sub
This should do it:
Option Explicit
Sub GoToFirstSheet()
Dim ws As Worksheet 'declare a worksheet variable
'loop through all the worksheets in the workbook
For Each ws In ThisWorkbook.Worksheets
'If the sheet is not hidden
If ws.Visible = xlSheetVisible Then
ws.Select 'select it
Exit For 'exit the loop
End If
Next ws
End Sub
I have numerous sheets, all with a button which activates a macro.
With VBA, how can I pick up the name of the macro attached to the shape on each sheet?
I have the code to look at each sheet, but can't see how to get the macro name from the shape properties.
Sub LoopandExamine()
Dim ws As Worksheet
Dim s As Shape
For Each ws In Worksheets
For Each s In ws.Shapes
If s.OnAction <> "" Then
Debug.Print s.Name & ";" & s.OnAction
End If
Next s
Next ws
End Sub
I would like to have a code that unchecks all checkboxes named "CheckBox1" for all sheets across the workbook. My current code unfortunately doesn't work, and I'm not sure why - it only works for the active sheet.
Private Sub CommandButton1_Click()
Dim Sheet As Worksheet
For Each Sheet In ThisWorkbook.Worksheets
Select Case CheckBox1.Value
Case True: CheckBox1.Value = False
End Select
Next
End Sub
This code iterates through all sheets (except sheets named Sheet100 and OtherSheet) and unchecks all your ActiveX checkboxes named CheckBox1
Sub uncheck_boxes()
Dim ws As Worksheet
Dim xbox As OLEObject
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Sheet100" And ws.Name <> "OtherSheet" Then
For Each xbox In ws.OLEObjects
ws.OLEObjects("CheckBox1").Object.Value = False
Next
End If
Next
End Sub
To uncheck all ActiveX checkboxes in all sheets disregarding the names used
Sub uncheck_all_ActiveX_checkboxes()
Dim ws As Worksheet
Dim xbox As OLEObject
For Each ws In ThisWorkbook.Worksheets
For Each xbox In ws.OLEObjects
ws.OLEObjects(xbox.Name).Object.Value = False
Next
Next
End Sub
To uncheck all Form Control checkboxes on a spreadsheet use
Sub uncheck_forms_checkboxes()
Dim ws As Worksheet
Dim xshape As Shape
For Each ws In ThisWorkbook.Worksheets
For Each xshape In ws.Shapes
If xshape.Type = msoFormControl Then
xshape.ControlFormat.Value = False
End If
Next
Next
End Sub
[edited following comments]
Try this:
Sub test()
Dim ws As Excel.Worksheet
Dim s As Object
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Definitions" And ws.Name <> "fx" Then
Set s = Nothing
On Error Resume Next
Set s = ws.OLEObjects("CheckBox1")
On Error GoTo 0
If Not s Is Nothing Then
s.Object.Value = False
End If
End If
Next ws
End Sub
This is a global function (it doesn't belong to a particular sheet), but you can put it inside CommandButton1_Click() if you want.
You might not need the error blocking if your sheets (other than Definitions and fx) always contain CheckBox1. Alternatively remove that if statement.
Here is some code from an xls file. In Excel 2010 it doesn't work. I can't find the collection Pictures in the object explorer
Private Sub Worksheet_Calculate()
Dim oPic As Picture
'make them invisible
For Each oPic In Me.Pictures
If Left(oPic.Name, 2) = "jq" Then
oPic.Visible = False
End If
Next
end sub
What would the equivalent 2010 code be?
Use this to loop through pictures in Excel
Sub Sample()
Dim shp As Shape
For Each shp In ActiveSheet.Shapes
If shp.Type = msoPicture Then
Debug.Print shp.Name
End If
Next
End Sub