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
Related
So, say for instance I have 2 sheets in my workbook... Page1 and OldName.
On sheet Page1 in cell A1 there is the value OldName (where "OldName" happens to be sheet name of the sheet I would like to rename).
Also on Page1 in cell A2, there is the value NewName (where "NewName" is the name I would like to change the sheet specified in cell A1 to).
I am Trying to come up with code that uses the the cell A1 to identify which sheet I would like to rename and then use the cell A2 as the source for the rename value.
Any suggestions?
You may try something along these lines:
Sub Test()
Dim sht As Worksheet
With ThisWorkbook
For Each sht In .Worksheets
If sht.Name = .Worksheets("Page1").Cells(1, 1).Value Then
sht.Name = .Worksheets("Page1").Cells(2, 1).Value
Exit For
End If
Next
End With
End Sub
try this simple loop
Sub ChangeNameLoop()
Dim wb As Workbook
Dim ws As Worksheet
Dim OldName As String, NewName As string
Set wb = ThisWorkbook
OldName = ActiveSheet.Range("A1") ' location of names
NewName = ActiveSheet.Range("A2")
For Each ws In wb.Worksheets
If ws.Name = OldName Then
ws.Name = NewName
End If
Next ws
End Sub
No need to loop. This will do what you want. This code will replace the sheet name if found else will do nothing.
Option Explicit
Sub Sample()
On Error Resume Next
With ThisWorkbook
.Sheets(.Sheets("Page1").Cells(1, 1).Value2).Name = _
.Sheets("Page1").Cells(2, 1).Value2
End With
On Error GoTo 0
End Sub
Or something like this
Option Explicit
Sub Sample()
Dim ws As Worksheet
With ThisWorkbook
On Error Resume Next
Set ws = .Sheets(.Sheets("Page1").Cells(1, 1).Value2)
On Error GoTo 0
If Not ws Is Nothing Then ws.Name = _
.Sheets("Page1").Cells(2, 1).Value2
End With
End Sub
I would like to make the all specified shapes gone from more than 1 sheet. It applies roughly to the "Cables" sheets.
It's related with my previous query:
VBA Excel select & delete all shapes with the same ID and remove
According to my query regarding the PDF saving
VBA excel excluding specified sheets when saving the .PDF version
I prepared the code, which looks as follows:
Sub Firestopshapes()
Dim shp As Shape
Dim Ws As Worksheet
If Ws.Name Like "*Cables*" Then
'Set Ws = ActiveSheet
For Each shp In Ws.Shapes
If shp.Name = "Firestop" Then
shp.Delete
End If
Next shp
End If
End Sub
Unfortunately I am getting error:
Object variable or With block variable not set
What have I done wrong here?
To close this question out... you forgot the loop through all the worksheets:
For Each Ws in ThisWorkbook.Worksheets
If Ws.Name Like "*Cables*" Then
...
End If
Next
Consider:
Sub Firestopshapes()
Dim shp As Shape
Dim Ws As Worksheet
For Each Ws In Sheets
If InStr(Ws.Name, "Cables") > 0 And Ws.Shapes.Count > 0 Then
For Each shp In Ws.Shapes
If shp.Name = "Firestop" Then
shp.Delete
End If
Next shp
End If
Next Ws
End Sub
I have a workbook with various worksheets. Each sheet has a button to open a userform which i used to input data in the respective sheet. E.g. button 1 in "sheet1" to open userform1 to input data in sheet1. Button 2 in "sheet2" to open userform2 to input data in sheet2 and so on.
I wanted to create shortcut buttons for each button 1,2 in the main sheet to directly open respective userform i wanted.
Thanks for your help in advance.
I supposed that the buttons are form controls and you rename their caption "Form1", "Form2" and so on ..
The first sheet name is "Main" >> so try this code that will copy your buttons to the Main sheet
Sub Test()
Dim ws As Worksheet
Dim sh As Worksheet
Dim shp As Shape
Dim rw As Long
Set ws = ThisWorkbook.Worksheets("Main")
rw = 5
Application.ScreenUpdating = False
For Each sh In ThisWorkbook.Worksheets
If sh.Name <> ws.Name Then
sh.Activate
For Each shp In ActiveSheet.Shapes
If shp.Type = msoOLEControlObject Or shp.Type = msoFormControl Then
If Left(shp.AlternativeText, 4) = "Form" Then
shp.Copy
Application.Goto Sheets("Main").Range("G" & rw)
ActiveSheet.Paste
rw = rw + 2
End If
End If
Next shp
End If
Next sh
Application.ScreenUpdating = True
End Sub
I would like to write a vba code that will not allow to add duplicate sheets with same name. I have a code that is assigned to button on the sheet that is used to change the name of the active sheet.
Sheets are copied from "Main" sheet and hence all the sheets will have button to rename the sheet based on the value selected in the cells A8 and K11 (Both these cells have drop down list with values).
My concern is when user selects the button to rename the sheet, it should look for all the sheets in workbook and display a message if duplicate sheet exists else it should rename the sheet. I am confused in passing values, I am still a starter. Please help
Sub RenameCurrentSheet()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim ws As Worksheet
ThisWorkbook.Unprotect Password:="xyz"
For x = 1 To worksh
If ActiveSheet.Name = "MainSheet" Then
MsgBox "You Cannot Change Name of This Sheet!!!"
Exit For
Else
ActiveSheet.Name = Range("A8").Value & "-" & Range("K11").Value
Exit For
End If
Next x
Application.DisplayAlerts = True
ThisWorkbook.Protect Password:="xyz"
End Sub
To iterate through the worksheets use code like this:
dim wks as Worksheet
for I = 1 to Application.Worksheets.Count
set wks = Application.Worksheets(i)
Debug.Print wks.Name
.... whatever else you want do do
next i
set wks = Nothing ' When done with the object
Just try and reference the worksheet to see if it exists - if it throws an error, then the sheet doesn't exist.
Your code fails as you're always looking at the activesheet, but never changing which sheet is active.
Public Sub CopyAndRenameSheet()
Dim wrkSht As Worksheet
Dim sNewName As String
With ThisWorkbook
'Copy the template to the end of the workbook.
.Worksheets("MainSheet").Copy After:=.Sheets(.Sheets.Count)
'Set reference to last sheet in workbook (the one you've just copied).
Set wrkSht = .Worksheets(.Sheets.Count)
With wrkSht
'Get the new name from the ranges.
sNewName = .Range("A8") & "-" & .Range("K11")
If WorkSheetExists(sNewName) Then
MsgBox "You Cannot Change Name of This Sheet!!!", vbOKOnly + vbCritical
'Do something with the sheet, otherwise you'll be left with a
'sheet called something like "MainSheet (1)".
Application.DisplayAlerts = False
wrkSht.Delete
Application.DisplayAlerts = True
Else
.Unprotect Password:="xyz"
wrkSht.Name = sNewName
.Protect Password:="xyz"
End If
End With
End With
End Sub
Public Function WorkSheetExists(SheetName As String, Optional WrkBk As Workbook) As Boolean
Dim wrkSht As Worksheet
If WrkBk Is Nothing Then
Set WrkBk = ThisWorkbook
End If
On Error Resume Next
Set wrkSht = WrkBk.Worksheets(SheetName)
WorkSheetExists = (Err.Number = 0)
Set wrkSht = Nothing
On Error GoTo 0
End Function
This code copies the name to be assigned from the template instead of the ActiveSheet. If you create the name from the active sheet and make sure that the name meets Excel requirements for sheet names, this code ought to work.
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.