Desbloquear automaticamente libro compartido y protegido

Tengo un excel compartido, el cual quiero proteger y compartir al mismo tiempo. Al tener una macro con distintas funcionalidades ( la uso para bloquear columnas y generar fechas de registros en las columnas contiguas) no corre.

Quiero proteger y compartir:

adjunto una captura de la macro y donde falla:

Es al poner ActiveWorkbook. ExclusiveAccess cuando da el error. He intentado poner para que desbloquue antes con la función:

ActiveWorkbook. Unprotect "abc" que es la contraseña que le he dado para desbloquear el compartir el libro, pero aun así sigue dando error.

Si no le pongo contraseña y solo comparto la macro que tengo funciona sin problemas

Respuesta
1

Primero que nada, tu evento "change" está, en la práctica, activo todo el tiempo, sugiero cambiar el orden de tu código, algo así:

1- Primero el "If" del "Intersect"

2- Segundo el "If" del "MultiUserEditing"

3- Desproteger la hoja

Eso para comenzar. Lo otro es ¿qué mensaje de error te sale? ¿Estás completamente seguro que la línea que se marca con el error es la que has mencionado?

Comentas

Abraham Valencia

Te adjunto la macro entera:

Private Sub Worksheet_Change(ByVal Target As Range)
Application.DisplayAlerts = False
If ActiveWorkbook.MultiUserEditing Then
ActiveWorkbook.UnprotectSharing "abc"
ActiveWorkbook.ExclusiveAccess

If Not Intersect(Target, Columns("K")) Is Nothing Then
ActiveSheet.Unprotect "abc"
For Each c In Target
Cells(c.Row, "L") = Date & " " & Time
Cells(c.Row, "L").Locked = True
Next
ActiveSheet.Protect "abc", _
DrawingObjects:=False, Contents:=True, _
Scenarios:=False, AllowFormattingCells:=True, _
AllowFormattingColumns:=True, AllowFormattingRows:=True, _
AllowInsertingColumns:=True, AllowInsertingRows:=True, _
AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
AllowDeletingRows:=True, AllowSorting:=True, _
AllowFiltering:=True, AllowUsingPivotTables:=True
End If
If Not Intersect(Target, Columns("M")) Is Nothing Then
ActiveSheet.Unprotect "abc"
For Each c In Target
Cells(c.Row, "N") = Date & " " & Time
Cells(c.Row, "N").Locked = True
Next
ActiveSheet.Protect "abc", _
DrawingObjects:=False, Contents:=True, _
Scenarios:=False, AllowFormattingCells:=True, _
AllowFormattingColumns:=True, AllowFormattingRows:=True, _
AllowInsertingColumns:=True, AllowInsertingRows:=True, _
AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
AllowDeletingRows:=True, AllowSorting:=True, _
AllowFiltering:=True, AllowUsingPivotTables:=True
End If

If Not Intersect(Target, Columns("P")) Is Nothing Then
ActiveSheet.Unprotect "abc"
For Each c In Target
Cells(c.Row, "Q") = Date & " " & Time
Cells(c.Row, "Q").Locked = True
Next
ActiveSheet.Protect "abc", _
DrawingObjects:=False, Contents:=True, _
Scenarios:=False, AllowFormattingCells:=True, _
AllowFormattingColumns:=True, AllowFormattingRows:=True, _
AllowInsertingColumns:=True, AllowInsertingRows:=True, _
AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
AllowDeletingRows:=True, AllowSorting:=True, _
AllowFiltering:=True, AllowUsingPivotTables:=True
End If
If Not Intersect(Target, Columns("R")) Is Nothing Then
ActiveSheet.Unprotect "abc"
For Each c In Target
Cells(c.Row, "S") = Date & " " & Time
Cells(c.Row, "S").Locked = True
Next
ActiveSheet.Protect "abc", _
DrawingObjects:=False, Contents:=True, _
Scenarios:=False, AllowFormattingCells:=True, _
AllowFormattingColumns:=True, AllowFormattingRows:=True, _
AllowInsertingColumns:=True, AllowInsertingRows:=True, _
AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
AllowDeletingRows:=True, AllowSorting:=True, _
AllowFiltering:=True, AllowUsingPivotTables:=True
End If
If Not Intersect(Target, Columns("U")) Is Nothing Then
ActiveSheet.Unprotect "abc"
For Each c In Target
Cells(c.Row, "V") = Date & " " & Time
Cells(c.Row, "V").Locked = True
Next
ActiveSheet.Protect "abc", _
DrawingObjects:=False, Contents:=True, _
Scenarios:=False, AllowFormattingCells:=True, _
AllowFormattingColumns:=True, AllowFormattingRows:=True, _
AllowInsertingColumns:=True, AllowInsertingRows:=True, _
AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
AllowDeletingRows:=True, AllowSorting:=True, _
AllowFiltering:=True, AllowUsingPivotTables:=True
End If
If Not Intersect(Target, Columns("W")) Is Nothing Then
ActiveSheet.Unprotect "abc"
For Each c In Target
Cells(c.Row, "X") = Date & " " & Time
Cells(c.Row, "X").Locked = True
Next
ActiveSheet.Protect "abc", _
DrawingObjects:=False, Contents:=True, _
Scenarios:=False, AllowFormattingCells:=True, _
AllowFormattingColumns:=True, AllowFormattingRows:=True, _
AllowInsertingColumns:=True, AllowInsertingRows:=True, _
AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
AllowDeletingRows:=True, AllowSorting:=True, _
AllowFiltering:=True, AllowUsingPivotTables:=True
End If
If Not Intersect(Target, Range("A:J")) Is Nothing Then
ActiveSheet.Unprotect "abc"
Target.Locked = True

ActiveSheet.Protect

ActiveSheet.Protect "abc", _
DrawingObjects:=False, Contents:=True, _
Scenarios:=False, AllowFormattingCells:=True, _
AllowFormattingColumns:=True, AllowFormattingRows:=True, _
AllowInsertingColumns:=True, AllowInsertingRows:=True, _
AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
AllowDeletingRows:=True, AllowSorting:=True, _
AllowFiltering:=True, AllowUsingPivotTables:=True
End If
If Not Intersect(Target, Range("Y:Y")) Is Nothing Then
ActiveSheet.Unprotect "abc"
Target.Locked = True

ActiveSheet.Protect

ActiveSheet.Protect "abc", _
DrawingObjects:=False, Contents:=True, _
Scenarios:=False, AllowFormattingCells:=True, _
AllowFormattingColumns:=True, AllowFormattingRows:=True, _
AllowInsertingColumns:=True, AllowInsertingRows:=True, _
AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
AllowDeletingRows:=True, AllowSorting:=True, _
AllowFiltering:=True, AllowUsingPivotTables:=True
End If
If Not Intersect(Target, Range("AA:AD")) Is Nothing Then
ActiveSheet.Unprotect "abc"
Target.Locked = True

ActiveSheet.Protect

ActiveSheet.Protect "abc", _
DrawingObjects:=False, Contents:=True, _
Scenarios:=False, AllowFormattingCells:=True, _
AllowFormattingColumns:=True, AllowFormattingRows:=True, _
AllowInsertingColumns:=True, AllowInsertingRows:=True, _
AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
AllowDeletingRows:=True, AllowSorting:=True, _
AllowFiltering:=True, AllowUsingPivotTables:=True
End If
If Not Intersect(Target, Range("O:O")) Is Nothing Then
ActiveSheet.Unprotect "abc"
Target.Locked = True

ActiveSheet.Protect

ActiveSheet.Protect "abc", _
DrawingObjects:=False, Contents:=True, _
Scenarios:=False, AllowFormattingCells:=True, _
AllowFormattingColumns:=True, AllowFormattingRows:=True, _
AllowInsertingColumns:=True, AllowInsertingRows:=True, _
AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
AllowDeletingRows:=True, AllowSorting:=True, _
AllowFiltering:=True, AllowUsingPivotTables:=True
End If
If Not Intersect(Target, Range("T:T")) Is Nothing Then
ActiveSheet.Unprotect "abc"
Target.Locked = True

ActiveSheet.Protect

ActiveSheet.Protect "abc", _
DrawingObjects:=False, Contents:=True, _
Scenarios:=False, AllowFormattingCells:=True, _
AllowFormattingColumns:=True, AllowFormattingRows:=True, _
AllowInsertingColumns:=True, AllowInsertingRows:=True, _
AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
AllowDeletingRows:=True, AllowSorting:=True, _
AllowFiltering:=True, AllowUsingPivotTables:=True
End If
ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.FullName, accessMode:=xlShared
Application.DisplayAlerts = True
End If
End Sub

y ahora una captura del error

y al picar en depurar donde me direcciona:

Creo que mi problema esta en no volver a bloquear y compartir la hoja

Primero coloca en "Modo Exclusivo" y después desprotege, si intentas desproteger primero te dará error pues los "libros compartidos" no lo permiten. Es una de sus, varias, limitaciones.

Abraham Valencia

Buenas,

Perdón por el retraso en contestar. He probado la opción que me sugieres, eliminando directamente "ActiveWorkbook.ExclusiveAccess" y para la primera celda que escribo algo no hay problema, pero al intentar hacer otra me sale de nuevo un error ( adjunto captura):

 Me temo que es debido ha que en el final de la macro no se darle la orden de volver a compartir y proteger por lo que al iniciarse de nuevo vuelve a dar error. Hay alguna forma de darle esta indicación? adjunto como tengo yo el final y el comienzo:

 y el final:

Application.DisplayAlerts = False
'evaluamos si el libro esta compartido
If ActiveWorkbook.MultiUserEditing Then
'si esta compartido, lo ponemos en modo exclusivo para hacer lo que necesites, incluido desproteger hojas 
ActiveWorkbook.ExclusiveAccess
'la bla bla
'guardamos el libro nuevamente como compartido
ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.FullName, _
accessMode:=xlShared
End If
'activamos alertas
Application.DisplayAlerts = True

Listo

Abraham Valencia

Buenas,

Esas son las ordenes iniciales que tenía. Mi problema viene causado porque además de compartir el libro quiero poner una contraseña a esa protección

Por eso daba la orden inicial de:

ActiveWorkbook.UnprotectSharing "abc"

El problema surgía al ir a cambiar un segunda celda, que al tener las ordenes:

ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.FullName, _
accessMode:=xlShared
End If
Application.DisplayAlerts = True

Lo que hace es guardarlo como compartido pero sin contraseña, por lo que al volver a comenzar y encontrarse con el "ActiveWorkbook.UnprotectSharing "abc" da un error.

ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.FullName, Password:= _
        "tu_clave", CreateBackup:=True, AccessMode:=xlShared

Comentas

Abraham Valencia

Lo del "CreateBackup" no lo coloques.

Abraham Valencia

Buenas,

Sigue sin funcionar, me sigue saliendo un error, así es como ha quedado:

Private Sub Worksheet_Change(ByVal Target As Range)
Application.DisplayAlerts = False
If ActiveWorkbook.MultiUserEditing Then
ActiveWorkbook.UnprotectSharing "abc"
ActiveWorkbook.ExclusiveAccess

( coloco indistintamente el exclusiveaccess antes y después de unprotect y el error salta igual)

ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.FullName, Password:=_
"abc", AccessMode:=xlShared
End If
Application.DisplayAlerts = True

El error que salta es:

Si elimino de la función el exclusiveAccess:

Private Sub Worksheet_Change(ByVal Target As Range)
Application.DisplayAlerts = False
If ActiveWorkbook.MultiUserEditing Then
ActiveWorkbook.UnprotectSharing "abc"
ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.FullName, Password:=_
"abc", AccessMode:=xlShared
End If
Application.DisplayAlerts = True

De todas formas, muchas gracias por tu ayuda. Si se te ocurre algo mas me comentas yo seguiré intentándolo..

Gracias.

Cuando usas esas opción de "proteger y compartir libro" las cosas cambian un "poco":

Application.DisplayAlerts = False
'evaluamos si el libro esta compartido
If ActiveWorkbook.MultiUserEditing Then
'si está compartido le quitamos la protección
ActiveWorkbook.UnprotectSharing "abc"
'Nos aseguramos 
MsgBox "sin compartir"
'guardamos el libro nuevamente como compartido
ActiveWorkbook.ProtectSharing Password:="abc", SharingPassword:="abc"
End If
'activamos alertas
Application.DisplayAlerts = True

Comentas

Abraham Valencia

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas

Tengo un subformulario en el que en un textbox aparece el campo mes en número y me gustaría se mostrase como texto

Como decía en el enunciado tengo un formulario con un subformulario en el que se muestran los datos de la selección del formulario pero cuando en periodicidad marco mensual aparecen los datos correctamente pero no consigo que se muestre el textBox...
2 respuestas

¿Cómo se quita mensaje de OLE?

A menudo excel se bloquea en todos los libros abiertos, luego al desbloquearse unos 3- 5 minutos después aparece el mensaje: "Microsoft Excel esta esperando que otra aplicación complete una acción OLE." ¿Cómo evitar todo esto y que no vuelva a suceder?
1 respuesta

Crear base de datos en excel

Como puedo crear una base de datos con Excel, que puedas introducir nombre, teléfono, tinte y registrar, buscar y eliminar
2 respuestas

Ocultar contraseña en macro

Tengo un archivo al cual le inserte una macro de apertura, que al abrir me pide contraseña, pero al digitarla muestra la contraseña, ¿Cómo hago para ocultarla? ¿Cómo hago para que al abrir esta me abra en una hoja especifica?
2 respuestas

Como crear una condición en un textbox

Debo crear una condición en esta Macro en el TextBox8 ( se ingresa una fecha) ya que en muchas ocasiones no debo ingresar dicha fecha, y si eso sucede no me permite seguir, como lograr para que esto no suceda Private Sub CommandButton2_Click() Dim...
2 respuestas

Ejecutar macro si en la celda B1 hay datos

Esta es la macro que utilizo siempre, pero tengo la dificultad que a veces me olvido de colocar el numero de curso (Ejp. 1era_1era o 2da_2da ...)en la celda B1, todo este proceso se ejecuta en la hoja Activa "Curso", lo que busco que la macro se...
2 respuestas

¿Qué hay de mal en este macro?

Quiero hacer un macro para hacer un filtro de una base de datos poniendo como condición un periodo de tiempo, teniendo una celda como fecha de inicio y otra celda como fecha de terminación. Te mando imagen de mi libro y código. Muchas gracias Sub...
1 respuesta

Need a good construction contractor for a home renovation project?

Interested in the uk area. Building a home will be a great investment and dream of their life for most of the people. It is really important to choose the best building contractor for this work. Choosing the right, trustworthy professional contractor...
7 respuestas

Saber el último precio de cierre de cada uno de los valores que compone una cartera de acciones y reflejarlos en un textBox.

Estoy construyendo un formulario para que se vuelque los datos de aquellos la situación de una cartera compuesta por acciones. Es un formulario único pero al clikear en un botón comando se abre un formulario continuo. La situación en la que estoy...
1 respuesta

Como puedo borrar registros relacionados desde un formulario

Tengo un formulario en donde tengo varios registros relacionados, deseo borrar cualquiera de esos registros pero me dice que no puedo borrar registros relacionados, quisiera saber si hay alguna opción con la que pueda borrar.
2 respuestas