vba code for changing the VBProject Properties sheet name has has stopped working.

heathball

Board Regular
Joined
Apr 6, 2017
Messages
135
Office Version
  1. 365
Platform
  1. Windows
Sub ZZcodechanger10()

'this code changes the property name to match the sheetname, and can have positive effects.
1716422316196.png




VBA Code:
Sub ZZcodechanger10()
Dim varItem As Variant

For Each varItem In ActiveWorkbook.VBProject.VBComponents
'Type 100 is a worksheet
If varItem.Type = 100 And varItem.Name <> "ActiveWorkbook" Then
varItem.Name = varItem.Properties("Name").Value
End If
Next

End Sub
VBA Code:

The following line is where the issue is

VBA Code:
varItem.Name = varItem.Properties("Name").Value
VBA Code:


It was working for a long time, and I am out of ideas,> perhaps someone knows something.:)

1716421925821.png
 

Excel Facts

What is =ROMAN(40) in Excel?
The Roman numeral for 40 is XL. Bill "MrExcel" Jelen's 40th book was called MrExcel XL.
In the unlikely event that anyone finds this interesting, Below is what someone has produced with the same goal.
If the longer version below is aiming for "automation" of the naming of the sheets, I could not achieve it.
But i could rename the code using the "ZZZZ" example below, which is typing in the name on the module.




VBA Code:
Private Sub ChangeCodeName(sh As Worksheet, strCodeName As String)
Dim shCModule As Object
Set shCModule = ActiveWorkbook.VBProject.VBComponents(sh.CodeName)
shCModule.Name = strCodeName
End Sub
Sub testFunctionChangeCodeName()
Dim sh As Worksheet
Set sh = Worksheets("ZZZZ") 'of course, this sheet name must exist...
ChangeCodeName sh, sh.Name
End Sub



Sub CodeNamesToNamesTEST()
CodeNamesToNames ThisWorkbook
End Sub

Sub CodeNamesToNames( _
ByVal wb As Workbook)
If wb Is Nothing Then Exit Sub

Const Dummy As String = "ZZZZ"

Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
dict.CompareMode = vbTextCompare

Dim sh As Object
For Each sh In wb.Sheets
dict(sh.Name) = sh.CodeName
Next sh

Dim proj As Object: Set proj = wb.VBProject

Dim Key As Variant
Dim n As Long
Dim oName As String
Dim nName As String
Do
For Each Key In dict.Keys
If StrComp(Key, dict(Key), vbBinaryCompare) = 0 Then ' match
dict.Remove Key
Else ' not a match
oName = dict(Key)
On Error Resume Next
proj.VBComponents(oName).Name = Key
Select Case Err.Number
Case 0
dict.Remove Key ' successfully renamed
Case 32813 ' code name is taken
n = n + 1
nName = Dummy & n
proj.VBComponents(oName).Name = nName
dict(Key) = nName
Case 50132 ' invalid code name...
' must start with [A-Za-z]
' can only contain [A-Za-z0-9_]
dict.Remove Key ' ... cannot be renamed!
End Select
On Error GoTo 0
End If
Next Key
Loop Until dict.Count = 0

End Sub
VBA Code:
 
Upvote 0

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top