• Revista PROGRAMAR: Já está disponível a edição #53 da revista programar. Faz já o download aqui!

Electro 99

Aplicação em VBA para fazer aparecer a negrito o sub-total

6 mensagens neste tópico

Bom dia amigos,

Estou a construir uma ferramenta para a elaboração de orçamentos, na qual estou a fazer que apareçam os SUB-TOTAIS em certas partes do orçamento, automaticamente.

Coloquei algumas fórmulas, de modo a que, ao marcar-se um "x" num determinado local, aparece na célula à esquerda (mesma linha), o valor do SUB-TOTAL, conforme podem ver na imagem que vos apresento a seguir.

file.php?id=1716

O que gostaria de saber é: alguem conhece o código em VBA que coloque a negrito o resultado do SUB-TOTAL?

Apesar ter algum conhecimento em Visual Basic, não sei como o aplicar ao excel.

Obrigado, desde já, pela vossa atenção

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Olá,

Não foi isto que pediste no meu blog (coloquei lá a resposta), mas tenta algo assim para a coluna "C"

Private Sub Worksheet_Change(ByVal Target As Range)
    
    On Error Resume Next

    If Not Intersect(Target, Range(Cells(2, "c"), Cells(Cells.Rows.Count, "c"))) Is Nothing Then
        If UCase(Target.Value) = "X" Then
            Cells(Target.Row, "b").Font.Bold = True
        Else
            Cells(Target.Row, "b").Font.Bold = False
        End If
    End If
    
End Sub

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Olá,

Não foi isto que pediste no meu blog (coloquei lá a resposta), mas tenta algo assim para a coluna "C"

Private Sub Worksheet_Change(ByVal Target As Range)
    
    On Error Resume Next

    If Not Intersect(Target, Range(Cells(2, "c"), Cells(Cells.Rows.Count, "c"))) Is Nothing Then
        If UCase(Target.Value) = "X" Then
            Cells(Target.Row, "b").Font.Bold = True
        Else
            Cells(Target.Row, "b").Font.Bold = False
        End If
    End If
    
End Sub

Obrigado, jpaulino.

Na verdade, já tinha colocado esta questão no teu blog, mas não me tinha apercebido que já tinhas respondido.

Vou experimentar o teu código.

Tu dizes "tenta algo assim para a coluna C". Referes-te à coluna C da folha de cálculo que apresento na imagem? Essa refere-se às unidades do orçamento :D

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Tu dizes "tenta algo assim para a coluna C". Referes-te à coluna C da folha de cálculo que apresento na imagem? Essa refere-se às unidades do orçamento :D

É a coluna onde colocas a cruz, ou seja, substituis o "c" pela coluna respectiva.

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

É a coluna onde colocas a cruz, ou seja, substituis o "c" pela coluna respectiva.

Ah, obrigado.

Já aadaaptei e está a resultar, quer para SUB-TOTAL, quer para TOTAL, de Material, Mão-de-obra e Final.

Utilizei o seguinte código:

Private Sub Worksheet_Change(ByVal Target As Range)
    
    On Error Resume Next

    If Not Intersect(Target, Range(Cells("an"), Cells(Cells.Rows.Count, "an"))) Is Nothing Then
        If UCase(Target.Value) = "X" Then
            Cells(Target.Row, "ag").Font.Bold = True
            Cells(Target.Row, "k").Font.Bold = True
            Cells(Target.Row, "w").Font.Bold = True
        Else
            Cells(Target.Row, "ag").Font.Bold = False
            Cells(Target.Row, "k").Font.Bold = False
            Cells(Target.Row, "w").Font.Bold = False
        End If
    End If
    
    
If Not Intersect(Target, Range(Cells("ao"), Cells(Cells.Rows.Count, "ao"))) Is Nothing Then
    If UCase(Target.Value) = "X" Then
            Cells(Target.Row, "ag").Font.Bold = True
            Cells(Target.Row, "k").Font.Bold = True
            Cells(Target.Row, "w").Font.Bold = True
    Else
            Cells(Target.Row, "ag").Font.Bold = False
            Cells(Target.Row, "k").Font.Bold = False
            Cells(Target.Row, "w").Font.Bold = False
    End If
End If
    
End Sub

Obrigado amigo.

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Ainda bem que está a funcionar :D

Quando o teu problema está resolvido, carregas em Topic Solved! (agora já está)

0

Partilhar esta mensagem


Link 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