Jump to content
  • 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

Recommended Posts

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

Share this post


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

Share this post


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

Share this post


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

Share this post


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

Share this post


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

Share this post


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

Share this post


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

Share this post


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

Share this post


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

Share this post


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

Share this post


Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now

×

Important Information

By using this site you accept our Terms of Use and Privacy Policy. We have placed cookies on your device to help make this website better. You can adjust your cookie settings, otherwise we'll assume you're okay to continue.