ERROR CON EL METODO PROTECTION

[jesuspg]

Hola amigos del foro,

Estoy ejecutando esta macro, y continuamente me muestra 'Error definido por la aplicación o el objeto':

Sub ProtegerHoja()

   Dim fila As Long
   fila = Sheets("Hoja1").Range("A1048576").End(xlUp).Row
   Dim contraseña As String
   contraseña = "abcd"

   With ActiveSheet
      .Protection.AllowEditRanges.Add Title:="Rango1", _
                                      Range:=Range("A3:H" & fila), _
                                      Password:=contraseña
      .Protect Password:=contraseña, _
               DrawingObjects:=True, _
               Contents:=True
      .EnableSelection = xlNoRestrictions
   End With

End Sub

No sé dónde puede estar el error... Por más que lo reviso, no logro encontrarlo.

De todos modos, he consultado la documentación que disponemos de Microsoft VBA en Internet, y en el código que dan como ejemplo también me muestra el mismo error.

Sub UseAllowEditRanges()

   Dim wksOne As Worksheet
   Dim strPwd1 As String

   Set wksOne = Application.ActiveSheet

   strPwd1 = InputBox("Enter Password")

   ' Unprotect worksheet.
   wksOne.Unprotect

   ' Establish a range that can allow edits
   ' on the protected worksheet.
   wksOne.Protection.AllowEditRanges.Add _
   Title:="Classified", _
   Range:=Range("A1:A4"), _
   Password:=strPwd1

   ' Notify the user
   ' the title and address of the range.
   With wksOne.Protection.AllowEditRanges.Item(1)
   MsgBox "Title of range: " & .Title
   MsgBox "Address of range: " & .Range.Address
   End With

End Sub

Os agradezco enormemente cualquier tipo de ayuda u orientación...

[bigpetroman]

saludos @paikerr si lo ejecutas la primera vez, funciona, las siguientes da error porque estas intentando sobreescribir los rangos que ya existen, una opcion es colocar esto antes de crearlo

On error resume next

ActiveSheet.Protection.AllowEditRanges("Rango1").Delete

y luego si tu codigo

[jesuspg]

@bigpetroman, muchísimas gracias por la correción.

Efectivamente, se debe a ese error.

Es decir, el rango de datos ya está creado bajo el nombre "Rango1" una vez que ejecutamos la macro por primera vez. Sin embargo, al ejecutar la misma macro varias veces, lo que hace es mostrar un error por pantalla porque está "pisando" de alguna manera el mismo rango con el mismo nombre.

Mi pregunta a continuación es: Cómo podemos comprobar que el rango de datos "Rango1" ya está creado? (de esta manera, nos evitamos usar el tratamiento de errores "On Error Resume Next")

Se me ocurre algo como esto:

...

If Range("Rango1") = True then
   ActiveSheet.Protection.AllowEditRanges("Rango1").Delete
Else
   With ActiveSheet
      .Protection.AllowEditRanges.Add Title:="Rango1", _
                                      Range:=Range("A3:H" & fila), _
                                      Password:=contraseña
      .Protect Password:=contraseña, _
               DrawingObjects:=True, _
               Contents:=True
      .EnableSelection = xlNoRestrictions
   End With
end if

 

[bigpetroman]

Saludos @paikerr, son formas diferentes de hacer lo mismo, todo es válido. particulamente en estos caso creo que el On Error Resume Next está justificado, no es un error que sale sin saber porque, es un error que se espera cuando ya existe el rango.

suerte

[Mauricio_ODN]

Hola @paikerr

Hace 2 horas, paikerr dijo:

Se me ocurre algo como esto:

Te dejo una alternativa:

''-->>

Sub Delete_oAllw()

Dim MeSh As Worksheet
Dim oPrt As Protection
Dim oAllw As AllowEditRanges
Dim Fila As Long

Set MeSh = ThisWorkbook.ActiveSheet
Set oPrt = MeSh.Protection
Set oAllw = oPrt.AllowEditRanges

MeSh.Unprotect contraseña
Fila = 100

For i = 1 To oAllw.Count
''-> Linea si quieres elimimar el rango
If oAllw(i).Title = "Rango1" Then oAllw(i).Delete
Next i

      oAllw.Add Title:="Rango1", _
               Range:=Range("A3:H" & Fila), _
               Password:=contraseña
    With MeSh
       .Protect Password:=contraseña, _
               DrawingObjects:=True, _
               Contents:=True
      .EnableSelection = xlNoRestrictions
   End With

End Sub

''<--

Nos Comentas.

[jesuspg]

Hola de nuevo compañeros,

En 30/7/2020 at 14:09 , bigpetroman dijo:

Saludos @paikerr, son formas diferentes de hacer lo mismo, todo es válido. particulamente en estos caso creo que el On Error Resume Next está justificado, no es un error que sale sin saber porque, es un error que se espera cuando ya existe el rango.

suerte

Llevas toda, todísima la razón. Aunque se me olvidó mencionar de que este código forma de un extracto de un módulo para gestionar los permisos de usuario en una aplicación ofimática, de modo que no puedo poner 'On Error Resume Next', porque en caso de error cualquier "usuario básico" tendría los mismos permisos de acceso en la aplicación ofimática que por ejemplo un "administrador" al quedar desprotegidas todas las hojas del libro. No sé si me explico...

De todos modos, llevas razón si simplemente se tratará de este código. En tal caso, si que utilizaría tu propuesta.

Pero muchas gracias por el feedback.

 

En 30/7/2020 at 16:19 , Mauricio_ODN dijo:

Hola @paikerr

Te dejo una alternativa:

''-->>

Sub Delete_oAllw()

Dim MeSh As Worksheet
Dim oPrt As Protection
Dim oAllw As AllowEditRanges
Dim Fila As Long

Set MeSh = ThisWorkbook.ActiveSheet
Set oPrt = MeSh.Protection
Set oAllw = oPrt.AllowEditRanges

MeSh.Unprotect contraseña
Fila = 100

For i = 1 To oAllw.Count
''-> Linea si quieres elimimar el rango
If oAllw(i).Title = "Rango1" Then oAllw(i).Delete
Next i

      oAllw.Add Title:="Rango1", _
               Range:=Range("A3:H" & Fila), _
               Password:=contraseña
    With MeSh
       .Protect Password:=contraseña, _
               DrawingObjects:=True, _
               Contents:=True
      .EnableSelection = xlNoRestrictions
   End With

End Sub

''<--

Nos Comentas.

Muchas gracias, @Mauricio_ODN.

Hay partes del código que si me interesan... Voy a echarlo un ojo y a probar con ello!

[bigpetroman]

Hace 1 hora, paikerr dijo:

Llevas toda, todísima la razón. Aunque se me olvidó mencionar de que este código forma de un extracto de un módulo para gestionar los permisos de usuario en una aplicación ofimática, de modo que no puedo poner 'On Error Resume Next', porque en caso de error cualquier "usuario básico" tendría los mismos permisos de acceso en la aplicación ofimática que por ejemplo un "administrador" al quedar desprotegidas todas las hojas del libro. No sé si me explico...

De todos modos, llevas razón si simplemente se tratará de este código. En tal caso, si que utilizaría tu propuesta.

Pero muchas gracias por el feedback.

Saludos @paikerr, pero la idea es que que esto sea solo una parte de todo tu código, una función tal vez, y allí si puedes usar el 'On Error Resume Next', que solo afectaría eso NO todo el código

suerte