Excel - 调整大小

Question

我已经编写了以下 UDF 并应用了我在网上找到的函数 (GetDisplayName)。当我尝试将单元格和硬编码列锁定在右侧 (A - J) 时，我不断收到 #value .这是由于 rCell.Resize .你能告诉我我做错了什么吗？我将 UDF 放在 I 列并引用 J 列( J2 )。我想锁定和硬编码 A2:J2。感谢任何帮助。

    Option Explicit
    Const sPassword = "Test123"
    Public Function ApplySignOff(rCell As Range) As String

    Dim sDisplayName As String
    Dim SingleSignOffCheck As String


    sDisplayName = GetDisplayName(Environ("USERNAME"))
    SingleSignOffCheck = Environ("USERDOMAIN") & "\" & Environ("USERNAME")

    Application.ScreenUpdating = False

        Unprtsht

        If Trim(rCell) = vbNullString Then

            ApplySignOff = vbNullString

        Else

            ApplySignOff = sDisplayName & " (" & SingleSignOffCheck & "  " & Now & ")"
            rCell.Resize(0, -10).Locked = True
            rCell.Resize(0, -10).Copy
            rCell.Resize(0, -10).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,      SkipBlanks _
                :=False, Transpose:=False
            rCell.Resize(0, -10).Paste
            Application.CutCopyMode = False

        End If

        Prtsht

    Application.ScreenUpdating = True

    Set rCell = Nothing

End Function

Public Function GetDisplayName(sAMAccountName As Variant) As String
Dim objconn As Object
Dim objCommand As Object
Dim objRoot As Object
Dim objDomain As Object
Dim objRS As Object
Dim strDomain As String
Dim strSQL As String
Dim varSearch As Variant

On Error GoTo PROC_ERR

GetDisplayName = ""

Set objconn = CreateObject("ADODB.Connection")
objconn.Provider = "ADsDSOObject"
objconn.Open "Active Directory Provider"

Set objCommand = CreateObject("ADODB.Command")
objCommand.ActiveConnection = objconn

Set objRoot = GetObject("LDAP://rootDSE")
strDomain = objRoot.get("defaultNamingContext")
Set objDomain = GetObject("LDAP://" & strDomain)
Const sPassword = "Test123"

strSQL = "SELECT displayname FROM 'LDAP://" & strDomain & "'" & _
    " WHERE sAMAccountName='" & sAMAccountName & "'"
objCommand.CommandText = strSQL

Set objRS = objCommand.Execute
If objRS.RecordCount > 0 Then
    With objRS
        .MoveFirst
        While Not .EOF
            GetDisplayName = !DisplayName
            .MoveNext
        Wend
        .Close
    End With
End If

PROC_EXIT:
Set objRS = Nothing
Set objconn = Nothing
Set objCommand = Nothing
Set objRoot = Nothing
Set objDomain = Nothing


Exit Function

PROC_ERR:
MsgBox "Error getting display name for " & sAMAccountName & ".  Error " & Err.Number & ": " & Err.Description, vbCritical
Resume PROC_EXIT

End Function
Public Function Unprtsht()
ActiveSheet.Unprotect sPassword
End Function

Public Function Prtsht()
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:=sPassword
End Function

Answer 1

UDF 只允许修改它输入的单元格:因此它不能执行您尝试执行的硬编码。