使用vba更改工作表的代号

时间:2013-12-28 19:04:36

标签: excel-vba vba excel

此代码在VBE窗口打开时工作正常,但在VBE窗口关闭时,此行引发错误Subscript out of rangewB.VBProject.VBComponents(wS.CodeName).Properties("_CodeName").Value = "wsData" 。也许有人可以告诉我这里我缺少的东西。

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 个答案:

答案 0 :(得分:9)

我怀疑它是two.dot rule的表现,或者至少是一个远房亲戚的表现。我能够重现你的问题。我通过声明整个VBA对象链来解决它,如下所示:

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

我必须设置对VBA Extensibility的引用才能执行此操作。

另请注意,用户必须通过选中“宏安全性”下的“信任对VBA项目模型的访问权限”来允许访问VBA可扩展性。您可以测试它是否设置如下:

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