Este fórum está sendo desativado

[SandroLima]

Boa noite, colegas do fórum.

Preciso da ajuda de vcs para acrescentar algumas funcionalidades na macro do botão "TESTE" da planilha anexa.

A macro funciona da seguinte maneira:

A partir da quantidade de itens informados na coluna "QTDE" da Tabela "Auxiliar" a macro redimensiona as tabelas da planilha PDF.

O que preciso:

1) Que a macro limite a quantidade de itens inseridos.
A quantidade de itens adicionados, não deve exceder 15 (somando-se as 4 tabelas) e quando exceder a quantidade aparecer uma msgbox informando que a quantidade de itens excedeu o limite permitido e sair da macro sem executar a rotina permanecendo na planilha ativa.

2) Os itens do rodapé (são 6)
a - Imagem da assinatura;
b - imagem do carimbo;
c - a expressão "Cliente ou responsável"
d - a barra de assinatura que fica logo acima dessa expressão
e - a expressão "Vendedor"
f - a barra de assinatura que fica logo acima dessa expressão
não fazem parte da imagem do plano de fundo e devem permanecer fixas nessa posição ou retornar a ela após a execução da macro.
Da forma como está ao rodar a macro elas "sobem" ou "descem" linhas conforme o redimensionamento das tabelas

3) As demais células da planilha estão "pintadas" de cinza para ocultar o plano de fundo no restante da planilha e de forma semelhante ao item anterior, as células pintadas são deslocadas ao redimensionar as tabelas.
Preciso manter o plano de fundo oculto no restante da planilha como está no arquivo (antes de rodar a macro).

Poderiam me ajudar com isso? Sugestões caso tenham ideia melhor para ocultar o plano de fundo no restante da planilha são bem vindas.

Segue planilha anexa.

[Kledison]

Boa noite!

para limitar a quantidade acrescente a macro abaixo ao seu código:

Código: Selecionar todos

If Range("N19") > 15 Then
    MsgBox "Quantidade de itens excedeu o limite permitido!!!", 64, "Atenção"
    Exit Sub
  End If

[SandroLima]

Boa tarde, Kledison e demais usuários do fórum.

Primeira demanda atendida deu certo... muito obrigado.

Vou deixar o tópico abeto pois ainda preciso dos itens 2 e 3 deste tópico.

Uma boa semana para todos.

[SandroLima]

Boa noite, pessoal.

O código da macro agora encontra-se da seguinte maneira:

Código: Selecionar todos

Sub Orcamento()
    
    Dim Tabela1 As ListObject, Tabela2 As ListObject, Tabela3 As ListObject, Tabela4 As ListObject
    Dim TabelaAuxiliar As ListObject, TabelaDestino As ListObject
    Dim QtdeItens As Long
    Dim Itens1 As Long, Itens2 As Long, Itens3 As Long, Itens4 As Long, ItensTotal As Long
    Dim InsereLinha as long
    Dim lngCont As Long
    
    Set Tabela1 = wsh_OrcamentoPDF.ListObjects("TB_Servicos")
    Set Tabela2 = wsh_OrcamentoPDF.ListObjects("TB_Produtos")
    Set Tabela3 = wsh_OrcamentoPDF.ListObjects("TB_Protese")
    Set Tabela4 = wsh_OrcamentoPDF.ListObjects("TB_OutrosItens")
    Set TabelaAuxiliar = wsh_OrcamentoPDF.ListObjects("TB_Auxiliar")
    
    Application.ScreenUpdating = False
    
    'Se não houver lançamentos para o período selecionado, os resultados da Tabela Auxiliar serão iguais a zero.
    'Se todas estiverem como zero, então não realiza o redimensionamento e sai da subrotina
    With TabelaAuxiliar.DataBodyRange
        'If .Cells(1, 5).Value = 0 And _
            .Cells(2, 5).Value = 0 And _
            .Cells(3, 5).Value = 0 And _
            .Cells(4, 5).Value = 0 And _
            .Cells(5, 5).Value = 0 Then
        If TabelaAuxiliar.TotalsRowRange.Cells(1, 5).Value = 0 Then
            VBA.MsgBox "Não existem itens lançados para esse orçamento!", vbExclamation, "Relatório"
            Application.ScreenUpdating = True
            
            Exit Sub
            
        End If
        
        If TabelaAuxiliar.TotalsRowRange.Cells(1, 5).Value > 15 Then
        
            MsgBox "Quantidade de itens excedeu o limite permitido!!!", 64, "Atenção"
            
            Exit Sub
        End If
    
        Set TabelaDestino = Tabela1
                QtdeItens = .Cells(1, 5).Value
                RedimensionaTabela lobTabela:=TabelaDestino, lngQtdeLinhas:=QtdeItens
        
        Set TabelaDestino = Tabela2
            QtdeItens = .Cells(2, 5).Value
            RedimensionaTabela lobTabela:=TabelaDestino, lngQtdeLinhas:=QtdeItens
 
    
        Set TabelaDestino = Tabela3
            QtdeItens = .Cells(3, 5).Value
            RedimensionaTabela lobTabela:=TabelaDestino, lngQtdeLinhas:=QtdeItens
            
        Set TabelaDestino = Tabela4
            QtdeItens = .Cells(4, 5).Value
            RedimensionaTabela lobTabela:=TabelaDestino, lngQtdeLinhas:=QtdeItens
            
    End With
    
    Itens1 = Tabela1.DataBodyRange.Rows.Count
    Itens2 = Tabela2.DataBodyRange.Rows.Count
    Itens3 = Tabela3.DataBodyRange.Rows.Count
    Itens4 = Tabela4.DataBodyRange.Rows.Count
    ItensTotal = Itens1 + Itens2 + Itens3 + Itens4

InsereLinha = 15 - ItensTotal 'Número de linhas a ser inserido abaixo da Tabela18 entre as Colunas B:F
    
        Application.ScreenUpdating = True
        
        Set TabelaDestino = Nothing
        Set Tabela1 = Nothing
        Set Tabela2 = Nothing
        Set Tabela3 = Nothing
        Set Tabela4 = Nothing
        Set TabelaAuxiliar = Nothing
        
        ActiveWorkbook.Sheets("PDF").Activate
    
End Sub

E como alternativa para a minha necessidade preciso do seguinte incremento na macro:

Se o valor de N19 (TabelaAuxiliar.TotalsRowRange.Cells(1, 5).Value) for maior que zero e menor que 15 que a macro localize a primeira linha abaixo da tabela "Tabela18" e insira a quantidade de linhas referente à diferença "15 - ItensTotal"
no intervalo entre as colunas B:F.

Poderiam me ajudar a codificar essa parte?

[SandroLima]

Boa noite...

Agora preciso que a macro:
1) localize a primeira linha abaixo da Tabela18

2) insira no intervalo entre as colunas B:F a quantidade de linhas referente à diferença 15 - ( Itens1 + Itens2 + Itens3 - Itens4).

Alguém sabe como proceder?

[SandroLima]

Boa noite, colegas do fórum.

Preciso que a macro:
1) localize a primeira linha abaixo da Tabela18

2) insira no intervalo entre as colunas B:F a quantidade de linhas referente à diferença 15 - ( Itens1 + Itens2 + Itens3 - Itens4).

Poderiam me ajudar com isso?

Segue planilha anexa.

[SandroLima]

Bom dia, pessoal.

Preciso que na macro existente na planilha anexa que:
Seja localizada a primeira linha abaixo da Tabela18 e que entre as colunas B:F (a partir da linha localizada) sejam inseridas a quantidade de linhas resultante da diferença 15 - ( Itens1 + Itens2 + Itens3 - Itens4).

Alguém poderia me ajudar com isso?

[SandroLima]

Bom dia, pessoal.

Alguém tem alguma sugestão?