Ir para conteúdo
Fórum Script Brasil

ritacruz

Membros
  • Total de itens

    1
  • Registro em

  • Última visita

Sobre ritacruz

ritacruz's Achievements

0

Reputação

  1. 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 Resposta
×
×
  • Criar Novo...