- 22 Abr 2021 às 11:32
#64024
Boa tarde,
Tenho um ficheiro excel com duas folhas.
Pretendo proteger uma das folhas totalmente e isso consigo fazê-lo no entanto a outra folha tem macros....
não pretendo protegê-la na totalidade mas apenas algumas colunas que contêm as macros. Ao proteger essas colunas pretendo ocultar as fórmulas e não permitir que terceiros as modifiquem.
Quando seleciono as colunas e depois faço proteger a folha as macros deixam de funcionar.
Apenas voltam a contabilizar os dados quando retiro a proteção.
Há alguma forma de proteger parte da folha selecionando as colunas para as fórmulas estarem ocultas e não sejam modificadas por terceiros sem que as macros deixem de funcionar?
Deixo a baixo as macros que o meu ficheiro excel tem.
Se me puderem ajudar...
Obrigado
Public Function CountColors(rng As Range, color As Integer) As Integer
Dim rg As Range
Dim x As Integer
' Valor inicial
CountColors = 0
' Ciclo que irá percorrer todas as células definidas
For Each rg In rng
' Caso a cor interior (background) seja a escolhida
If rg.Interior.ColorIndex = color Then
' Incrementa o contador
x = x + 1
End If
Next
' Define que a função (valor a retornar) tem o valor de x
CountColors = x
End Function
----------------------------------------------------------
Public Function Boldsum(intervalo As Range) As Double
Dim Celula As Range
Dim Acumulador As Double
For Each Celula In intervalo
If Celula.Font.Bold And VBA.IsNumeric(Celula.Value) Then
Acumulador = Acumulador + Celula.Value
End If
Next
Boldsum = Acumulador
End Function
-------------------------------------------------
Function SumItalics(rSumRange As Range)
Dim rCell As Range
Dim vResult
For Each rCell In rSumRange
If rCell.Font.Italic Then
vResult = WorksheetFunction.Sum(rCell) + vResult
End If
Next rCell
SumItalics = vResult
End Function
-----------------------------------------------------
Function SOMACOR(qRange As Range, ByVal qCor$) As Double
Dim c As Range, xcolor&, xvalue#
Select Case qCor$
Case "VERMELHO"
xcolor& = 255
End Select
Contador = 0
For Each c In qRange
If c.Font.color = xcolor Then
Contador = Contador + 1
End If
Next
SOMACOR = Contador
End Function
-----------------------------------------
Function ContarCores(intervalo As Range, corInterior As Integer, corFonte As Integer) As Integer
Dim c As Range
Dim q As Integer
q = 0
Application.Volatile
For Each c In intervalo
If c.Interior.ColorIndex = corInterior And c.Font.ColorIndex = corFonte Then
q = q + 1
End If
Next c
ContarCores = q
End Function
-----------------------------------------
Function CONTAR_VERMELHO_NEGRITO(pRange)
Dim iCell As Range
Dim Result As Long
For Each iCell In pRange
If iCell.Value2 = 1 Then
If iCell.Font.color = vbRed And iCell.Font.Bold Then
Result = Result + 1
End If
End If
Next iCell
CONTAR_VERMELHO_NEGRITO = Result
End Function
Tenho um ficheiro excel com duas folhas.
Pretendo proteger uma das folhas totalmente e isso consigo fazê-lo no entanto a outra folha tem macros....
não pretendo protegê-la na totalidade mas apenas algumas colunas que contêm as macros. Ao proteger essas colunas pretendo ocultar as fórmulas e não permitir que terceiros as modifiquem.
Quando seleciono as colunas e depois faço proteger a folha as macros deixam de funcionar.
Apenas voltam a contabilizar os dados quando retiro a proteção.
Há alguma forma de proteger parte da folha selecionando as colunas para as fórmulas estarem ocultas e não sejam modificadas por terceiros sem que as macros deixem de funcionar?
Deixo a baixo as macros que o meu ficheiro excel tem.
Se me puderem ajudar...
Obrigado
Public Function CountColors(rng As Range, color As Integer) As Integer
Dim rg As Range
Dim x As Integer
' Valor inicial
CountColors = 0
' Ciclo que irá percorrer todas as células definidas
For Each rg In rng
' Caso a cor interior (background) seja a escolhida
If rg.Interior.ColorIndex = color Then
' Incrementa o contador
x = x + 1
End If
Next
' Define que a função (valor a retornar) tem o valor de x
CountColors = x
End Function
----------------------------------------------------------
Public Function Boldsum(intervalo As Range) As Double
Dim Celula As Range
Dim Acumulador As Double
For Each Celula In intervalo
If Celula.Font.Bold And VBA.IsNumeric(Celula.Value) Then
Acumulador = Acumulador + Celula.Value
End If
Next
Boldsum = Acumulador
End Function
-------------------------------------------------
Function SumItalics(rSumRange As Range)
Dim rCell As Range
Dim vResult
For Each rCell In rSumRange
If rCell.Font.Italic Then
vResult = WorksheetFunction.Sum(rCell) + vResult
End If
Next rCell
SumItalics = vResult
End Function
-----------------------------------------------------
Function SOMACOR(qRange As Range, ByVal qCor$) As Double
Dim c As Range, xcolor&, xvalue#
Select Case qCor$
Case "VERMELHO"
xcolor& = 255
End Select
Contador = 0
For Each c In qRange
If c.Font.color = xcolor Then
Contador = Contador + 1
End If
Next
SOMACOR = Contador
End Function
-----------------------------------------
Function ContarCores(intervalo As Range, corInterior As Integer, corFonte As Integer) As Integer
Dim c As Range
Dim q As Integer
q = 0
Application.Volatile
For Each c In intervalo
If c.Interior.ColorIndex = corInterior And c.Font.ColorIndex = corFonte Then
q = q + 1
End If
Next c
ContarCores = q
End Function
-----------------------------------------
Function CONTAR_VERMELHO_NEGRITO(pRange)
Dim iCell As Range
Dim Result As Long
For Each iCell In pRange
If iCell.Value2 = 1 Then
If iCell.Font.color = vbRed And iCell.Font.Bold Then
Result = Result + 1
End If
End If
Next iCell
CONTAR_VERMELHO_NEGRITO = Result
End Function
