Ir para conteúdo
Fórum Script Brasil
  • 0

Proteger parte de uma folha de cálculo de excel e respectivas macros


ritacruz

Pergunta

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
 Resposta Rápida
 
Link para o comentário
Compartilhar em outros sites

1 resposta a esta questão

Posts Recomendados

Participe da discussão

Você pode postar agora e se registrar depois. Se você já tem uma conta, acesse agora para postar com sua conta.

Visitante
Responder esta pergunta...

×   Você colou conteúdo com formatação.   Remover formatação

  Apenas 75 emoticons são permitidos.

×   Seu link foi incorporado automaticamente.   Exibir como um link em vez disso

×   Seu conteúdo anterior foi restaurado.   Limpar Editor

×   Você não pode colar imagens diretamente. Carregar ou inserir imagens do URL.



  • Estatísticas dos Fóruns

    • Tópicos
      152,3k
    • Posts
      652,3k
×
×
  • Criar Novo...