Question

我已经编写了下面的UDF并应用了我在线找到的函数（GetDisplayName）。当我尝试将单元格和硬编码列锁定到右侧（A - J）时，我不断得到#value。这是由于rCell.Resize。你能告诉我我做错了吗？我将UDF放在第一列并引用第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修改输入的单元格：因此无法进行您尝试进行的硬编码。

Answer 2

您需要使用Set关键字重新定义当前范围，如下所示。范围大小与范围的当前大小无关，因此它将尝试将大小调整为0列-10行。您可以将rCell.columns.count和rCell.rows.count的值存储在变量中，然后使用

set rCell = rCell.Resize(columnCount, rowCount)

然后参考rCell

rCell.locked = True
rCell.copy
...etc

Excel - 调整大小

2 个答案: