Public Function SetCellProperties(wkhsheet As String, RangeA As String, RangeB As String, pswd As String, ParamArray Props()) As Boolean
Dim rng As Range
Dim lngIndex As Long, n As Long
Dim vardata As Variant
Dim objProp As Object
SetCellProperties = False
On Error GoTo ErrorHandler
If Len(pswd) > 0 Then
Sheets(wkhsheet).Unprotect Password:=pswd
End If
Set rng = Sheets(wkhsheet).Range(RangeA, RangeB)
For lngIndex = LBound(Props) To UBound(Props) Step 2
vardata = Split(Props(lngIndex), ".")
n = LBound(vardata)
If n < UBound(vardata) Then
Set objProp = CallByName(rng, vardata(n), VbGet)
n = n + 1
Do While n < UBound(vardata)
Set objProp = CallByName(objProp, vardata(n), VbGet)
Loop
CallByName objProp, vardata(UBound(vardata)), VbLet, Props(lngIndex + 1)
Else
CallByName rng, vardata(UBound(vardata)), VbLet, Props(lngIndex + 1)
End If
Next lngIndex
If Len(pswd) > 0 Then
Sheets(wkhsheet).Protect Password:=pswd
End If
SetCellProperties = True
Exit Function
ErrorHandler:
Exit Function
End Function
|