Proteger celdas con formato en VBA
Necesito proteger las celdas de una hoja que tengan un formato determinado. Estas celdas pueden hallarse en cualquier fila/columna de la hoja.
Estoy usando la siguiente instrucción pero me da error 9 "subíndice fuera del intervalo".
Application.FindFormat.Interior.ColorIndex = 40
Cells.Find(What:="", After:=Range("A1"), LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=True).Select
Selection.Locked = False
Selection.FormulaHidden = False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Es como si no me encontrara ninguna celda, aunque sí que existen celdas con ese formato.
Aunque he puesto Range("A1"), en realidad la búsqueda debe realizarse por toda la hoja.
Estoy usando la siguiente instrucción pero me da error 9 "subíndice fuera del intervalo".
Application.FindFormat.Interior.ColorIndex = 40
Cells.Find(What:="", After:=Range("A1"), LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=True).Select
Selection.Locked = False
Selection.FormulaHidden = False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Es como si no me encontrara ninguna celda, aunque sí que existen celdas con ese formato.
Aunque he puesto Range("A1"), en realidad la búsqueda debe realizarse por toda la hoja.
Respuesta de jferg
1
Te recomiendo que mejor uses un bucle. Por ejemplo si quieres buscar las celdas que tienen el formato que quieres en el rango A1:B100 entonces
worksheets("Nombre"). Unprotect "contraseña"
For Columna= 1 to 2
For Fila= 1 to 100
if worksheets("Nombre").Cells(Fila,Columna).Interior.ColorIndex=MiValor then
worksheets("Nombre").Cells(Fila,Columna).Locked=False ' o True segun lo que quieras
End If
Next Fila
Next Columna
Worksheets("Nombre"). Protect Contraseña
worksheets("Nombre"). Unprotect "contraseña"
For Columna= 1 to 2
For Fila= 1 to 100
if worksheets("Nombre").Cells(Fila,Columna).Interior.ColorIndex=MiValor then
worksheets("Nombre").Cells(Fila,Columna).Locked=False ' o True segun lo que quieras
End If
Next Fila
Next Columna
Worksheets("Nombre"). Protect Contraseña
Me gustaría saber por qué es mejor el bucle que esta instrucción.
A priori no sé en qué filas ni columnas se encuentran estas celdas, y puede haber hojas con muchas filas y columnas informadas.
Si lo hago con Edición > Buscar > Reemplazar esto funciona, entonces, ¿por qué no puedo hacerlo con VBA que seguramente debe ser más óptimo?
A priori no sé en qué filas ni columnas se encuentran estas celdas, y puede haber hojas con muchas filas y columnas informadas.
Si lo hago con Edición > Buscar > Reemplazar esto funciona, entonces, ¿por qué no puedo hacerlo con VBA que seguramente debe ser más óptimo?
No te discuto que también funcione. Yo solo te doy una opción que también puede darte solución. De todas maneras ten en cuenta que es posible que para que tu código funcione adecuadamente en la hoja donde haces la búsqueda debe haber una selección activa
Para asegurarte de que haya una selección en la cual buscar puedes usar
Activesheet.Cells.Select
Si la hoja tiene contraseña debes desprotegerla como te indique en el código
No se si el método que usas continué buscando en toda la hoja después de encontrar la primera celda con la característica desada.
El código que te propongo garantiza búsqueda en toda la hoja si ajustas Inicio a 1 y Fin a 65536 para 2003 y 1000000 y algo más para 2007) y así mismo columnas (256 para 2003 y algo como 16000 para 2007). Lo que no se es cuanto se demore. Ahora si estas seguro de que los rangos son continuos puedes usar un bucle do while not isempty(Cells(Fila, Columna) e ir incrementando la columna cada vez que se encuentre una fila vacía en la columna actual para evitar ciclos innecesarios:
Columna= 1
Activesheet. Unprotect "contraseña"
Empezar:
Fila=1
Do while not isempty(Cells(Fila,Columna)) and Fila<= 65536
if Cells(Fila,Columna).Interior.ColorIndex=MiValor then
Cells(Fila,Columna).Locked=False
End If
Fila=Fila+1
loop
If Columna+1 <256 then Columna=Columna+1 : Goto Empezar
Activesheet. Protect Contraseña
Para asegurarte de que haya una selección en la cual buscar puedes usar
Activesheet.Cells.Select
Si la hoja tiene contraseña debes desprotegerla como te indique en el código
No se si el método que usas continué buscando en toda la hoja después de encontrar la primera celda con la característica desada.
El código que te propongo garantiza búsqueda en toda la hoja si ajustas Inicio a 1 y Fin a 65536 para 2003 y 1000000 y algo más para 2007) y así mismo columnas (256 para 2003 y algo como 16000 para 2007). Lo que no se es cuanto se demore. Ahora si estas seguro de que los rangos son continuos puedes usar un bucle do while not isempty(Cells(Fila, Columna) e ir incrementando la columna cada vez que se encuentre una fila vacía en la columna actual para evitar ciclos innecesarios:
Columna= 1
Activesheet. Unprotect "contraseña"
Empezar:
Fila=1
Do while not isempty(Cells(Fila,Columna)) and Fila<= 65536
if Cells(Fila,Columna).Interior.ColorIndex=MiValor then
Cells(Fila,Columna).Locked=False
End If
Fila=Fila+1
loop
If Columna+1 <256 then Columna=Columna+1 : Goto Empezar
Activesheet. Protect Contraseña
Perdona por favor que no te haya contestado antes, pero las veces que he intentado conectarme no he podido acceder a la web.
Necesitaría hacerlo con esa única instrucción, puesto que mi macro recorre varias hojas en múltiples libros y un bucle tarda demasiado tiempo.
De todas formas voy a probar esta solución que me dices porque seguro que le puedo encontrar alguna otra aplicación.
Recapitulando, necesito que la famosa instrucción funcione. Si quieres cierro este tema y abro otro para poder solventar lo de la instrucción, o seguimos con ello, como más te convenga.
Gracias de nuevo por la ayuda, recibe un cordial saludo.
Necesitaría hacerlo con esa única instrucción, puesto que mi macro recorre varias hojas en múltiples libros y un bucle tarda demasiado tiempo.
De todas formas voy a probar esta solución que me dices porque seguro que le puedo encontrar alguna otra aplicación.
Recapitulando, necesito que la famosa instrucción funcione. Si quieres cierro este tema y abro otro para poder solventar lo de la instrucción, o seguimos con ello, como más te convenga.
Gracias de nuevo por la ayuda, recibe un cordial saludo.
He notado que en tu código al final proteges la hoja. Pienso que es necesario que al iniciar la rutina la desprotejas (Activesheet. Unprotect "password"). Quizás a si funcione. Seguiremos tratando
¡Hola!
Al final he hecho un bucle pero usando el comando Find, así restrinjo el bucle a las celdas que tienen el formato que busco y no tengo que recorrer toda la hoja. Encontré un ejemplo por internet (siento no haber guardado la dirección) que pongo aquí por si es de utilidad:
Application.FindFormat.Interior.ColorIndex = 40
Set HoldCell = .Cells.Find(What:="", _
after:=ActiveCell, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=True)
Set TempCheck = HoldCell
If Not TempCheck Is Nothing Then
Do
Application.FindFormat.Interior.ColorIndex = 40
Set TempCheck = .Cells.Find(What:="", _
after:=TempCheck, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=True)
TempCheck.Select
Selection.Locked = False
Selection.FormulaHidden = False
Loop Until TempCheck Is Nothing Or TempCheck.Address = HoldCell.Address
Aunque al final no he usado (en este caso) tu ejemplo, valoro mucho tu dedicación.
Gracias y hasta la próxima (que la habrá...)
¡Un saludo!
Al final he hecho un bucle pero usando el comando Find, así restrinjo el bucle a las celdas que tienen el formato que busco y no tengo que recorrer toda la hoja. Encontré un ejemplo por internet (siento no haber guardado la dirección) que pongo aquí por si es de utilidad:
Application.FindFormat.Interior.ColorIndex = 40
Set HoldCell = .Cells.Find(What:="", _
after:=ActiveCell, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=True)
Set TempCheck = HoldCell
If Not TempCheck Is Nothing Then
Do
Application.FindFormat.Interior.ColorIndex = 40
Set TempCheck = .Cells.Find(What:="", _
after:=TempCheck, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=True)
TempCheck.Select
Selection.Locked = False
Selection.FormulaHidden = False
Loop Until TempCheck Is Nothing Or TempCheck.Address = HoldCell.Address
Aunque al final no he usado (en este caso) tu ejemplo, valoro mucho tu dedicación.
Gracias y hasta la próxima (que la habrá...)
¡Un saludo!
