Change codename of worksheet with vba

Question

This code works fine with VBE window open, but raises an error Subscript out of range at this line: wB.VBProject.VBComponents(wS.CodeName).Properties("_CodeName").Value = "wsData" when VBE window is closed. Maybe someone can show me what I'm missing here.

Sub newWorkbook()
    Dim wB As Workbook
    Dim wS As Worksheet
    Dim Proj As Object'<=== added

    Set wB = Workbooks.Add
    Set wS = wB.Worksheets(1)
    wS.Name = "Data"

    Set Proj = wB.VBProject '<== added
    'wB.VBProject.VBComponents(wS.CodeName).Properties("_CodeName").Value = "wsData" '<==Original line
    Proj.VBComponents(wS.CodeName).Properties("_CodeName").Value = "wsData" '<== New

    On Error Resume Next
    Application.DisplayAlerts = False
    wB.SaveAs "C:\dummy.xls", 56

    Application.DisplayAlerts = True
    If Not wB Is Nothing Then wB.Close False
    Set wB = Nothing
End Sub

Answer 1

I need to be able to change the CodeName of selected worksheets

I needed to be able to change the CodeName of selected worksheets in an application I'm writing. I found some code written and/or modified by "j2associates". However I was still getting errors when I tried to run it. I needed to change two variable types:

Dim vbTest As VBIDE.VBComponent

in Function ProgrammaticAccessAllowed

and

Dim oProperty As Property

in Sub ChangeCodeName

I changed them both to Objects:

Dim vbTest As Object

and

Dim oProperty As Object

However I did not want the CodeNames to be conversions of the Sheet/Tab names. So I altered the code so it would accept different Sheet/Tab names and CodeNames.

As I often want to add worksheets using code, I wrote a macro to do it. I'm sure my work can be improved on.

'This Sub adds a new worksheet, allowing you to input
'the sheets Tab/Name and CodeName.
'Usage e.g.  Call NewWorksheet("New Tab", "New_CodeName")
Sub NewWorksheet(inTabName As String, inCodeName As String)
Dim ws As Worksheet

    Set ws = ThisWorkbook.Sheets.Add(After:= _
             ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    ws.Name = inTabName
    Call ChangeCodeName(ws, inCodeName)
    Set ws = Nothing
End Sub 'NewWorksheet


'This Function is called by the ChangeCodeName Sub.
Private Function IsLetter(inChr As String) As Boolean

    IsLetter = False
    inChr = UCase(inChr)
    If Asc(inChr) > 64 And Asc(inChr) < 91 Then IsLetter = True
End Function 'IsLetter




'The original code for the following I got from:
'https://stackoverflow.com/questions/20818249/change-codename-of-worksheet-with-vba
'By: j2associates
'I altered it ever so slightly.


'This Function is called by the ChangeCodeName Sub.
Private Function ProgrammaticAccessAllowed() As Boolean
Dim vbTest As Object

    On Error Resume Next
    Set vbTest = ThisWorkbook.VBProject.VBComponents(1)
    
    If Err.Number = 0 Then
        ProgrammaticAccessAllowed = True
    End If 'Err.Number = 0
    
    On Error GoTo 0
    Set vbTest = Nothing
End Function 'ProgrammaticAccessAllowed


'This Sub is called by the NewWorksheet Sub.
Private Sub ChangeCodeName(inWS As Worksheet, inCodeName As String)
Dim oProperty As Object, _
    ChrIndex  As Integer, _
    inChr     As String

    With inWS
        
        If ProgrammaticAccessAllowed Then
            
            'Converts prohibited characters into an underscore "_".
            For ChrIndex = 1 To Len(inCodeName)
                inChr = Mid(inCodeName, ChrIndex, 1)
                
                If IsLetter(inChr) = False _
                 And IsNumeric(inChr) = False _
                 And inChr <> "_" _
                Then
                    inCodeName = Replace$(inCodeName, inChr, "_")
                End If 'IsLetter(inChr) = False And... And...
                
            Next ChrIndex
            
            'Removes numbers and underscore as the first characters.
            'as this is also prohibited.
            While Left(inCodeName, 1) = "_" Or IsNumeric(Left(inCodeName, 1))
                inCodeName = Right(inCodeName, Len(inCodeName) - 1)
            Wend 'Left(inCodeName, 1) = "_" Or IsNumeric(Left(inCodeName, 1))
            
            Set oProperty = .Parent.VBProject.VBComponents.Item(.CodeName) _
                            .Properties.Item("_CodeName")
                            
            On Error Resume Next
            oProperty.Value = inCodeName
            On Error GoTo 0
        End If 'ProgrammaticAccessAllowed
        
    End With 'inWS
    Set oProperty = Nothing
End Sub 'ChangeCodeName

Answer 2

I know this is an old thread, but it was very helpful as I needed to change the CodeName programmatically. Using @Doug Glancy's code above as a starting point, including the ProgramatticAccessedAllowed method, I was able to create a much smaller method to create a CodeName from the Sheet Name with the spaces, dashes and periods removed.

    Public Function ProgrammaticAccessAllowed() As Boolean
    Dim vbTest As VBIDE.VBComponent
    
    On Error Resume Next
        Set vbTest = ThisWorkbook.VBProject.VBComponents(1)
        If Err.Number = 0 Then
            ProgrammaticAccessAllowed = True
        End If
    On Error GoTo 0
    End Function
    
    Public Sub ChangeCodeName(oSheet As Worksheet)
    Dim oProperty As Property
    Dim sCodeName As String
        With oSheet
            If ProgrammaticAccessAllowed Then
                ' Sheet name with spaces, dashes and periods removed.
                sCodeName = Replace$(Replace$(Replace$(.Name, " ", vbNullString), "-", vbNullString), ".", vbNullString)
            
                Set oProperty = .Parent.VBProject.VBComponents.Item(.CodeName).Properties.Item("_CodeName")
                ''Debug.Print oProperty.Name, oProperty.Value, sCodeName
    On Error Resume Next
                oProperty.Value = sCodeName
    On Error GoTo 0
            End If
        End With
    End Sub

Answer 3

I suspect it's a manifestation of the two.dot rule, or at least a distant relative. I was able to reproduce your problem. I solved it by declaring the whole chain of VBA objects, like this:

Sub newWorkbook()
Dim wB As Workbook
Dim wS As Worksheet
Dim vbProj As VBIDE.VBProject
Dim vbComps As VBIDE.VBComponents
Dim vbComp As VBIDE.VBComponent
Dim vbProps As VBIDE.Properties
Dim CodeNameProp As VBIDE.Property

Set wB = Workbooks.Add
Set wS = wB.Worksheets(1)
wS.Name = "Data"

Set vbProj = wB.VBProject
Set vbComps = vbProj.VBComponents
Set vbComp = vbComps(wS.CodeName)
Set vbProps = vbComp.Properties
Set CodeNameProp = vbProps("_Codename")
CodeNameProp.Value = "wsData"

On Error Resume Next
Application.DisplayAlerts = False
wB.SaveAs "E:\docs\dummy.xls", 56

Application.DisplayAlerts = True
If Not wB Is Nothing Then wB.Close False
Set wB = Nothing
End Sub

I had to set a reference to VBA Extensibility to do this.

Also note that the user has to have allowed access to VBA extensibility, by checking "Trust Access to the VBA Project Model" under Macro Security. You can test whether it's set like this:

Function ProgrammaticAccessAllowed() As Boolean
Dim vbTest As VBIDe.vbComponent

On Error Resume Next
Set vbTest = ThisWorkbook.VBProject.VBComponents(1)
If Err.Number = 0 Then
    ProgrammaticAccessAllowed = True
End If
End Function