Change codename of worksheet with vba

后端 未结 1 1627
野趣味
野趣味 2021-02-14 17:19

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(\"_CodeN

1条回答
  •  难免孤独
    2021-02-14 17:42

    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
    

    0 讨论(0)
提交回复
热议问题