在 Excel 2007 中运行良好的 vba 代码不会在 Excel 2013 中运行

Question

我有一些 vba 代码可以添加用户名和密码来设置用户编辑范围。
该代码在 Excel 2007 中运行良好，但是当我尝试在 Excel 2013 中运行它时，我不断收到运行时错误 1004 应用程序定义或对象定义错误。 代码在 erTimeInputs 行处停止。 我相信这是因为变量 erTimeInputs 没有任何值，但我无法让它接受一个值。我试图将其定义为各种数据类型，但似乎没有任何效果。

这是我的代码：

Sub AddUserEditRanges()

'Update username and password before running this macro

Dim UserNameArr() As Variant
Dim UserRangeArr()  As Variant
Dim UserPsswdArr() As Variant
Dim v As Variant
Dim LastUserRow As Integer
Dim i As Integer
Dim ws As Worksheet, rng As Range, UserRange As Range, aer As AllowEditRange
Dim UserName As String
Dim Psswd As String
Dim erTimeInputs as Variable

'Find number of users
LastUserRow = Range("A170").End(xlDown).Row

'set arrays
UserNameArr = Range("B168:B" & LastUserRow).Value
UserPsswdArr = Range("C168:C" & LastUserRow).Value
UserRangeArr = Range("D168:D" & LastUserRow).Value

    For v = LBound(UserNameArr) To UBound(UserNameArr)

    UserName = UserNameArr(v, 1)
    UserRange = UserRangeArr(v, 1)
    Psswd = UserPsswdArr(v, 1)

        'Add edit ranges to the worksheets for all users.
       Set erTimeInputs = _
              Worksheets("Week1").Protection.AllowEditRanges.Add(Title:= _
              UserName, Range:=Worksheets("Week1") _
              .Range(UserRange), Password:=Psswd)

        Set erTimeInputs = _
              Worksheets("Week2").Protection.AllowEditRanges.Add(Title:= _
              UserName, Range:=Worksheets("Week2") _
              .Range(UserRange), Password:=Psswd)
    Next


End Sub

Answer 1

如评论所述，您可以将变量显式声明为 AllowEditRange 变量类型。
现在，只要您分配给它的 Title 不存在就应该没有问题，否则它会抛出运行时错误。
我不知道你为什么需要设置或分配给变量对象，但如果你想要的只是添加用户名和密码，你可以在不分配给变量的情况下做到这一点。

For v = LBound(UserNameArr) To UBound(UserNameArr)
    UserName = UserNameArr(v, 1)
    UserRange = UserRangeArr(v, 1)
    Psswd = UserPsswdArr(v, 1)
    'Check if worksheet is unprotected and ready for editing
    If Worksheet("Week1").ProtecContents = True Then Msgbox "Unprotect Sheet first", _
        vbCritical: Exit Sub

    'Add edit ranges to the worksheets for all users.
    If AllowEditExist(UserName, Worksheets("Week1")) Then
        'Delete Existing
        Worksheets("Week1").Protection.AllowEditRanges(UserName).Delete
    End If
        'Add New 
    Worksheets("Week1").Protection.AllowEditRanges.Add Ttle:= _
        UserName, Range:=Worksheets("Week1") _
        .Range(UserRange), Password:=Psswd
Next

Edit1：下面的例程将检查 AllowEditRange 是否已经存在。

Function AllowEditExist(mytitle As String, sh As Worksheet) As Boolean
    Dim a As AllowEditRange: AllowEditExist = False
    For Each a In sh.Protection.AllowEditRanges
        If a.Title = mytitle Then
            AllowEditExist = True
            Exit For
        End If
    Next
End Function

重要提示：在添加、删除AllowEditRanges之前应取消对工作表的保护，否则会报错。