Jump to content
Fórum Script Brasil
  • 0

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


Question

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 to post
Share on other sites

1 answer to this question

Recommended Posts

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Answer this question...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

Cloud Computing


  • Forum Statistics

    • Total Topics
      149264
    • Total Posts
      645605
×
×
  • Create New...