Change codename of worksheet with vba

2020-06-16 02:08发布

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

1条回答
Bombasti
2楼-- · 2020-06-16 02:54

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
查看更多
登录 后发表回答