Ir para o conteúdo
  • Revista PROGRAMAR: Já está disponível a edição #60 da revista programar. Faz já o download aqui!

Blue_Wings

Código para somar células ao fazer duplo click

Mensagens Recomendadas

Blue_Wings

Boa tarde pessoal,

Tenho este seguinte código (que me ajudaram a construir, porque eu não percebo muito disto) que faz o que pretendo, que é somar as células ao fazer duplo click com o rato numa determinada célula até a coluna nº16, vai fazer a soma numa determinada linha, neste caso linha 51.

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

If Target.Column > 16 Then Exit Sub

Dim i As Integer

i = Target.Column

    If Target.Interior.ColorIndex = xlNone Then

        Target.Interior.ColorIndex = 15

        Cells(51, i).Value = Cells(51, i).Value + Target.Value

    Else

        Target.Interior.ColorIndex = xlNone

        Cells(51, i).Value = Cells(51, i).Value - Target.Value

    End If

Cancel = True

End Sub

É possível restringir a zona da soma de células e a zona de duplo click ? do género, numa folha de calculo ter uma área de click só no meio da folha ? como se fosse só para clicar entre E17 até G27 e para somar cada uma das colunas E,F,G nas respectivas E28,F28,G28

.

Um abraço

Partilhar esta mensagem


Ligação para a mensagem
Partilhar noutros sites
rogi_cps

Pelo que entenci, creio que deva ser isso que quer.

Option Explicit



Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim i As Integer
Dim a As Integer

'não pode após coluna 16
If Target.Column > 7 Or Target.Column < 5 Then
    Exit Sub
End If

'não pode células menor que 17 e maior que 27
If Target.Row > 27 Or Target.Row < 17 Then
    Exit Sub
End If


'carrega variável com o valor da coluna
i = Target.Column

'se celula sem cor, define cor e soma
    If Target.Interior.ColorIndex = xlNone Then
        Target.Interior.ColorIndex = 15
'o numero 28 deine a célula que deve aparecer a soma.
        Cells(28, i).Value = Cells(10, i).Value + Target.Value
'se tem cor retiraa cor e subtrai
    Else
        Target.Interior.ColorIndex = xlNone
        Cells(28, i).Value = Cells(10, i).Value - Target.Value
    End If

Cancel = True
End Sub

Espero que tenha ajudado.  Qualquer coisa.. posta novamente.

Flw!

Partilhar esta mensagem


Ligação para a mensagem
Partilhar noutros sites
Blue_Wings

Obrigado pela resposta era isso mesmo, mas ainda tenho um problema por resolver, mudei a coluna 7 para 10

If Target.Column > 10 Or Target.Column < 5 Then

Mudei para 10 porque a minha tabela começa na linha E17 mas está unida com a F17, o mesmo sucede com as 2 colunas seguintes G17 com H17 e I17 com J17 (tenho 3 colunas), mas vou mostrar a imagem para ser mais fácil de perceber, é possível que tenha problemas por ter células unidas horizontalmente ?  é que ao fazer duplo click está a dar-me o erro: Type mismatch (Error 13)

excel1b.jpg

É possível contornar esta situação mantendo a união das células ?

Obrigado

Partilhar esta mensagem


Ligação para a mensagem
Partilhar noutros sites
rogi_cps

Kra... eu fiz meio rápido... ve se isso resolve...  se apresentar erro me fala...

Option Explicit



Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

'não pode após coluna 16
If Target.Column > 7 Or Target.Column < 5 Then
    Exit Sub
End If

'não pode células menor que 17 e maior que 27
If Target.Row > 27 Or Target.Row < 17 Then
    Exit Sub
End If


'carrega variável com o valor da coluna

'se celula sem cor, define cor e soma
    If Target.Interior.ColorIndex = xlNone Then
        Target.Interior.ColorIndex = 15
'o numero 28 deine a célula que deve aparecer a soma.
        ActiveSheet.Cells(28, Target.Column).Value = ActiveSheet.Cells(28, i).Value + ActiveSheet.Cells(Target.Row, Target.Column).Value
'se tem cor retiraa cor e subtrai
    Else
        Target.Interior.ColorIndex = xlNone
        ActiveSheet.Cells(28, Target.Column).Value = ActiveSheet.Cells(28, i).Value - ActiveSheet.Cells(Target.Row, Target.Column).Value
    End If

Cancel = True
End Sub

Flw!

Partilhar esta mensagem


Ligação para a mensagem
Partilhar noutros sites
Blue_Wings

Obrigado pela resposta, mas não está a funcionar, o debug diz que a variável não estava definida então eu acrescentei:

Dim i As Integer (já pus lá por baixo do Private Sub mas continua a não funcionar) dá Run-time error 1004 (Application-defined or object defined error)

Vou enviar o que pretendo em anexo pode ser que seja mais facil assim, se puder fazer isso para as duas tabelas agradeço.

A ideia na 1ª tabela é somar os valores da coluna 5 até a coluna 10 e da linha 17 até a linha 27 e obter o resultado na linha 28

Na 2ª tabela é somar os valores da coluna 14 até a coluna 23 e da linha 17 até a linha 27 e obter o resultado na linha 28

Fico a aguardar para ver como se faz e eventualmente aprender.

Pus o exemplo do ficheiro excel online que já tem as tabelas para se poder fazer download: http://www.megaupload.com/?d=YKTVWK61

Obrigado mais uma vez.

Partilhar esta mensagem


Ligação para a mensagem
Partilhar noutros sites
rogi_cps

eu ou fazer sim para vc...  mas se quiser adiantar, é que eu troquei a variável "i" direto pelo comando.  Então no lugar de i fica "target.column".

O erro apresentado é por causa da variável mesmo, como eu arranquei ela do código fonte...  ela não está sendo carregada,  o que implica que tb não está sendo carregado valor.

e uando vai executar o procedimento que ela ainda está descrita, ela ocasiona error.

troca ela pelo coamndo q mencionei acima, pq somente vou poder dar uma olhada a noite (Brasil).

Caso isso resolva o prbl, que creio que vai, posta aqui que deu certo, se não eu pego os arquivos a noite e resolvo pra vc meu amigo.

Flw!

Partilhar esta mensagem


Ligação para a mensagem
Partilhar noutros sites
Blue_Wings

Bom dia já funciona  :cheesygrin:

Mas ao lado dessa tabela tenho outra como descrevi anteriormente, fiz desta maneira e resultou: Adicionei um And (Target.Column > 23 Or Target.Column < 14)

Option Explicit



Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)



'não pode após coluna 16
If (Target.Column > 10 Or Target.Column < 5) And (Target.Column > 23 Or Target.Column < 14) Then
    Exit Sub
End If

'não pode células menor que 17 e maior que 27
If Target.Row > 27 Or Target.Row < 17 Then
    Exit Sub
End If


'carrega variável com o valor da coluna

'se celula sem cor, define cor e soma
    If Target.Interior.ColorIndex = xlNone Then
        Target.Interior.ColorIndex = 15
'o numero 28 deine a célula que deve aparecer a soma.
        ActiveSheet.Cells(28, Target.Column).Value = ActiveSheet.Cells(28, Target.Column).Value + ActiveSheet.Cells(Target.Row, Target.Column).Value
'se tem cor retiraa cor e subtrai
    Else
        Target.Interior.ColorIndex = xlNone
        ActiveSheet.Cells(28, Target.Column).Value = ActiveSheet.Cells(28, Target.Column).Value - ActiveSheet.Cells(Target.Row, Target.Column).Value
    End If
    
    
Cancel = True
End Sub

Está tudo a funcionar, então agora neste momento desprotegi as células onde faço o duplo click e também onde faço a soma e protegi a folha, depois fui testar e está a dar erro: Run-time error 1004 (Application-defined or object defined error)

Não se pode proteger a folha de excel com excepção das células onde é necessário fazer o duplo click e a soma na linha 28?

Por outras palavras: desprotegi as todas as células das duas tabelas na totalidade e mandei proteger a folha de excel, o que faz com que todas as restantes célulasfiquem protegidas, porque tenho mais dados na folha que não pretendo que sejam mexidos.

Abraço

Partilhar esta mensagem


Ligação para a mensagem
Partilhar noutros sites
rogi_cps

o qu deseja é possivel de ser feito...  e faço o tempo todo...  selecione a area que irá ser alterada, depois click com o direito  vá em formatar células (pode estar um pouco diferente, por causa das versões de PT, o meu é BR e o seu deve ser PT-PT), depois vá em proteção e retire a opção bloqueadas.

Pronto.. agora pode proteger a planilha somente que essas células poderão ser alteradas e o restante não serão.

Fico feliz que tenha dado certo a codificação.

Flw, se precisar de ajuda... é só falar!

Partilhar esta mensagem


Ligação para a mensagem
Partilhar noutros sites
Blue_Wings

Bom dia, desde já obrigado pela ajuda no código, fiz isso que me disseste retirei a opção bloqueadas na area que pode ser alterada  e depois protegi a planilha e ao fazer isso se fizer mais tarde o tal duplo click dá dá Run-time error 1004 (Application-defined or object defined error)

O que poderá estar mal ? Parece só funcionar se não proteger a planilha.

Vou deixar aqui o novo ficheiro já a funcionar mas com o problema de proteger a planilha, se puderes fazer download e verificar agradeço: http://www.megaupload.com/?d=OH6CPMCI

O código de protecção da planilha é 1234

Abraço

Partilhar esta mensagem


Ligação para a mensagem
Partilhar noutros sites
rogi_cps

tentei pegar seu arquivo, porém está indisponível...  será que poderia postar novamente??  Vou precisa dele para tratar desse erro,...  Valeu

Partilhar esta mensagem


Ligação para a mensagem
Partilhar noutros sites
rogi_cps

Ae Blue...  To te enviando a codificação que uso em Of2k3 para fazer o bloqueio e desbloqueio das planilhas...  dá uma olhada, coloca para desproteger na entrada da chamada e3 protege no final da chamada...

Não esquece, é uma rotina...  que vc colocar no módulo e somente faz a chamada pelo nome.

Qualquer coisa vc me fala.

public sub Desproteger()
On Error GoTo ErrDesprot
'desprotege o arquivo
Workbooks(1).Unprotect "rogi"
'desprotge a planilha
Worksheets(1).Unprotect "rogi"

ErrDesprot:
Exit Sub
End Sub


public sub Proteger()
On Error GoTo ErrProot
'desprotege o arquivo
Workbooks(1).protect "rogi"
'desprotge a planilha
Worksheets(1).protect "rogi"

ErrProt:
Exit Sub
End Sub

Espero que ajude.

Flw!

Partilhar esta mensagem


Ligação para a mensagem
Partilhar noutros sites

Crie uma conta ou ligue-se para comentar

Só membros podem comentar

Criar nova conta

Registe para ter uma conta na nossa comunidade. É fácil!

Registar nova conta

Entra

Já tem conta? Inicie sessão aqui.

Entrar Agora

×

Aviso Sobre Cookies

Ao usar este site você aceita os nossos Termos de Uso e Política de Privacidade. Este site usa cookies para disponibilizar funcionalidades personalizadas. Para mais informações visite esta página.