RafaVillani

@Jefferson TSkkkkk....realmente me esqueci do End If, não fiz o código no Excel, fiz direto aqui no fórum, e acabei me esquecendo de fechar o If, mas, o importante é que funcionou. 

@Jefferson TSVocê marcou seu próprio post como solução....rsrsrsrs

@Jefferson TSDê um enter nessa linha, após o Select e antes do Selection.

@Jefferson TSTente este código, onde estou agora não pude testar, se der erro me avise.

Sub ExcluiLinha()

Dim Tabela As ListObject
Dim UltimaLinha As Long

Set Tabela = Planilha9.ListObjects("Tabela11")
UltimaLinha = Tabela.ListRows.Count
If UltimaLinha = 1 Then
    MsgBox "Nenhum registro encontrado, impossível excluir!", vbInformation, "ERRO"
    Exit Sub
Else:
Call Desprotege
Sheets("ficha_treino").Select
Range("A13").Select Selection.End(xlDown).Select
Selection.EntireRow.Delete
Range("A13").Select
Selection.End(xlDown).Select
Call Protege
End Sub

RafaVillani

@genecioficialconsegui usando apenas uma célula. segue a fórmula:

=SE(G2<=F2;" VIGENTE Falta(m) "&SE(DATADIF(G2;F2;"y")=0;"";DATADIF(G2;F2;"y")&" Ano(s), ")&SE(DATADIF(G2;F2;"ym")=0;"";DATADIF(G2;F2;"ym")&" Mês(es) e ")&SE(DATADIF(G2;F2;"md")=0;"";DATADIF(G2;F2;"md")&" Dia(s)")&" para o vencimento da CNH.";"VENCIDO a "&SE(DATADIF(F2;G2;"y")=0;"";DATADIF(F2;G2;"y")&" Ano(s), ")&SE(DATADIF(F2;G2;"ym")=0;"";DATADIF(F2;G2;"ym")&" Mês(es) e ")&SE(DATADIF(F2;G2;"md")=0;"";DATADIF(F2;G2;"md")&" Dia(s)")&" RENOVAR CNH.")

RafaVillani

@Jefferson TSColoque este linha de comando antes do primeiro For.

If LinhaListbox < 0 Then
    MsgBox "Nenhum registro selecionado!", vbInformation, "ERRO"
    Exit Sub
End If

RafaVillani

@Jefferson TSSubstitua essas linhas:

Tabela1.DataBodyRange.Cells(L).Delete por

Tabela1.ListRows(L).Delete

e Tabela2.DataBodyRange.Cells(L).Delete por

Tabela2.ListRows(L).Delete

Veja se funciona assim, aqui funcionou com ambas as linhas.

RafaVillani

 @Jefferson TS, você vem criando seus posts no lugar errado (Programação-Outros-Visual Basic), por mais que VBA seja baseado em Visual Basic, acredito que o correto seria criar em Pacotes de Escritorio-Microsoft Office.

Sobre sua dúvida, veja se o código lhe atende.

Dim Tabela1 As ListObject, Tabela2 As ListObject
Dim LinhaTabela1 As Long, LinhaTabela2 As Long
Dim L As Long, LinhaListbox As Long

Set Tabela1 = Planilha8.ListObjects("BASE_PRESENÇAS")
Set Tabela2 = Planilha8.ListObjects("TABELA_PRESENÇAS")
 
LinhaTabela1 = Tabela1.ListRows.Count
LinhaTabela2 = Tabela2.ListRows.Count
 
LinhaListbox = Me.ListBoxBAIXA.ListIndex

For L = 1 To LinhaTabela1
    If Tabela1.DataBodyRange.Cells(L, 2) = Me.ListBoxBAIXA.List(LinhaListbox, 1) Then
        Tabela1.DataBodyRange.Cells(L).Delete
        L = L - 1
    End If
Next L

For L = 1 To LinhaTabela2
    If Tabela2.DataBodyRange.Cells(L, 2) = Me.ListBoxBAIXA.List(LinhaListbox, 1) Then
        Tabela2.DataBodyRange.Cells(L).Delete
        Exit Sub
    End If
Next L

RafaVillani

@Jefferson TSConsegui melhorar o filtro por parte do nome, agora ele funciona com o cabeçalho fixo, se lhe interessar basta substituir todo o código da Sub FiltroParte por esse:

Dim linhamatriz As Long, Linha As Long
Dim ultimalinha As Range
Dim fonte(1 To 500, 1 To 6) As Variant
Dim Cont As Integer
Dim L As Long
linhamatriz = 1
Linha = 6
Cont = 4
Me.ListBoxFIADO.RowSource = Empty
Me.ListBoxFIADO.ColumnHeads = True
L = Planilha5.Range("A5").CurrentRegion.Rows.Count + 4
Planilha5.Range("A5:F" & L).ClearContents
Set ultimalinha = Plan1.Range("A1000000").End(xlUp)
Plan1.Select
With Plan1
    Do While Linha <= ultimalinha.Row
        If UCase(.Cells(Linha, 2)) Like UCase("*" & (TextBox1) & "*") Then
                fonte(linhamatriz, 1) = .Cells(Linha, 1)
                fonte(linhamatriz, 2) = .Cells(Linha, 2)
                fonte(linhamatriz, 3) = .Cells(Linha, 3)
                fonte(linhamatriz, 4) = .Cells(Linha, 4)
                fonte(linhamatriz, 5) = .Cells(Linha, 5)
                fonte(linhamatriz, 6) = .Cells(Linha, 6)
                Cont = Cont + 1
                linhamatriz = linhamatriz + 1
        End If
        Linha = Linha + 1
    Loop
End With
If Cont = 4 Then
    Me.ListBoxFIADO.RowSource = Planilha5.Range("A5:F5").Address
    Exit Sub
End If
Planilha5.Select
Planilha5.Range("A5:F" & Cont) = fonte
Me.ListBoxFIADO.RowSource = Planilha5.Range("A5:F" & Cont).Address

RafaVillani

@paulocezarpicos

5 horas atrás, paulocezarpicos disse:

Minhas desculpas RafaVillani e muito obrigado pela ajuda

Sem problemas, tudo certo! Precisando é só chamar!

@GENECIOFICIALOlá, veja se lhe atende, para testar basta alterar a data de vencimento.

RafaVillani

dma-ant-vcto-dma-ap-vcto.xlsx

@paulocezarpicosEu usei a planilha do post #7, quando ocorre a mensagem de planilha bloqueada? Lembro que para fazer qualquer alteração na aba Geral, primeiro você deve desbloquear a planilha, caso contrario a mensagem irá aparecer mesmo.

RafaVillani

LEITURA4.rar

@paulocezarpicosSegue novamente a planilha.

RafaVillani

LEITURA4.rar

@paulocezarpicosSegue a planilha!

RafaVillani

LEITURA4.rar

@Jefferson TSVeja se lhe atende esse filtro por parte do texto. O único problema é, ao adicionar este filtro eu não consigo mais fazer o cabeçalho fixo, então você terá de fazer o cabeçalho manualmente, utilizando labels.

RafaVillani

CONTROLE NOVO - Copia.rar

@Mayara RezendeSe entendi direito isso deve resolver. Dentro do evento SelectionChange adicione o comando If antes de chamar sua Sub lsMover, assim:

If ToggleButton1_onoff.Value = True Then
    lsMover
Else: MsgBox "Favor Ativar Movimentação do Quadro!"
    Exit Sub
End If

RafaVillani

@paulocezarpicosSegue a planilha com o filtro muito mais rápido.

Lembrando que, conforme sua aba maio2021 você apenas pode filtrar um intervalo de 30 dias.

RafaVillani

LEITURA.rar

@paulocezarpicos

28 minutos atrás, paulocezarpicos disse:

Não dá pra ser as datas no userform já criado não??

Mas está dessa forma, você deve inserir as datas nos textbox do userform. Dessa forma esta muito lento, estou escrevendo um código mais rápido. Assim que finalizar eu envio a planilha.

RafaVillani

@paulocezarpicosRespondi no outro tópico.

RafaVillani

@paulocezarpicosVeja se lhe atende, esta um pouco lento devido ao número de informações.

RafaVillani

LEITURA.rar

@Jefferson TSDentro do botão baixar crie uma nova variável: Dim linhapago As Long

e, entre as linhas de comando Plan1.Cells(L, 7) = Date e cont = 1, cole este código:

linhapago = Plan2.Range("A4").CurrentRegion.Rows.Count + 4
Plan2.Cells(linhapago, 1) = Plan1.Cells(L, 1)
Plan2.Cells(linhapago, 2) = Plan1.Cells(L, 2)
Plan2.Cells(linhapago, 3) = Plan1.Cells(L, 3)
Plan2.Cells(linhapago, 4) = Plan1.Cells(L, 4)
Plan2.Cells(linhapago, 5) = Plan1.Cells(L, 5)
Plan2.Cells(linhapago, 6) = Plan1.Cells(L, 6)
Plan2.Cells(linhapago, 7) = Plan1.Cells(L, 7)
Plan1.Rows(L).Delete

RafaVillani

@Jefferson TS

1 hora atrás, Jefferson TS disse:

E tem como deixar o cabeçalho da listbox não selecionável?

Tem sim, faça as seguintes alterações:

No evento Initialize do UserFormBAIXAR_FIADO insira este código abaixo da linha TextBoxDATA_FIADO = Date

L = Plan1.Range("A4").CurrentRegion.Rows.Count + 3

Set base = Plan1.Range(Plan1.Cells(5, 1), Plan1.Cells(L, 7))

NOME = "'" & Plan1.Name & "'!"
    
ListBoxFIADO.RowSource = NOME & base.Address
ListBoxFIADO.ColumnCount = 7


ListBoxFIADO.ColumnHeads = True

If L = 1 Then
    ListBoxFIADO.ColumnHeads = False
End If

E substitua todo o código da Sub FiltroFiado por este:

Dim base As Range
Dim crt As Range
Dim filtrada As Range
Dim NOME As String
Dim L As Long

Set base = Plan1.Range("A4").CurrentRegion
Set crt = Planilha5.Range("J1:P2")

base.AdvancedFilter xlFilterCopy, crt, Planilha5.Range("A4:G4")
L = Planilha5.Range("A4").CurrentRegion.Rows.Count

Set filtrada = _
Planilha5.Range(Planilha5.Cells(5, 1), Planilha5.Cells(L + 3, 7))
NOME = "'" & Planilha5.Name & "'!"
    
UserFormBAIXAR_FIADO.ListBoxFIADO.RowSource = NOME & filtrada.Address

If L = 1 Then
    UserFormBAIXAR_FIADO.ListBoxFIADO.ColumnHeads = False
End If

Isso fará o cabeçalho ficar fixo.

1 hora atrás, Jefferson TS disse:

Sabe me dizer como trazer para o listbox apenas linhas que não tenham data de pagamento, ou seja, trazer apenas os devedores?

Tem como sim, mas teriamos que alterar a forma como os dados são carregados na listbox, e isso atrapalharia o Filtro, para contornar isso, aconselho você criar uma nova aba, "Pagos\Baixados" por exemplo, e ao clicar no botão Baixar a data é inserida e os dados baixados enviados para a planilha "Pagos\Baixados", dessa forma o listbox sempre irá listar apenas os devedores.

RafaVillani

@Jefferson TSVamos lá, primeiro altere algumas propriedades do UserFormBAIXAR_FIADO e do ListBoxFIADO, para configura-los corretamente, conforme abaixo.

UserFormBAIXAR_FIADO

propriedade Width coloque 580

ListBoxFIADO

propriedade ColumnWidths coloque 60 pt;100 pt;49.95 pt;60 pt;75 pt;55 pt;49.95 pt

propriedade MultiSelect coloque 1-fmMultiSelectMulti

prorpiedade Width coloque 545

6 horas atrás, Jefferson TS disse:

Preciso selecionar as linhas desejadas da ListBoxFiado para quando clicar no botão baixar, seja lançada a data atual na base de dados (na coluna data de pagamento).

Dentro do evento Click do botao Baixar cole este código:

Dim i As Integer, L As Long, cont As Integer
Dim linha As Long
cont = 0
linha = Plan1.Range("A4").CurrentRegion.Rows.Count + 3
For i = 0 To ListBoxFIADO.ListCount - 1
    If ListBoxFIADO.Selected(i) = True Then
           For L = 6 To linha
                If Plan1.Cells(L, 1) = ListBoxFIADO.List(i, 0) And Plan1.Cells(L, 2) = ListBoxFIADO.List(i, 1) _
                And Plan1.Cells(L, 3) = ListBoxFIADO.List(i, 2) And Plan1.Cells(L, 4) = ListBoxFIADO.List(i, 3) _
                And Plan1.Cells(L, 5) = ListBoxFIADO.List(i, 4) And Plan1.Cells(L, 6) = ListBoxFIADO.List(i, 5) Then
                    Plan1.Cells(L, 7) = Date
                    cont = 1
                End If
            Next
    End If
Next
If cont = 1 Then
    Call FiltroFiado
End If

6 horas atrás, Jefferson TS disse:

E ainda, na textboxTOTALFIADO seja somado em tempo real as linhas selecionadas da listbox.

Crie uma nova Sub, duplo clique no UserFormBAIXAR_FIADO e cole este código:

Sub Soma_Selecao()

Dim Item As Integer
Dim Soma As Double
Soma = 0

For Item = 0 To ListBoxFIADO.ListCount - 1
    If ListBoxFIADO.Selected(Item) = True And IsNumeric(ListBoxFIADO.List(Item, 5)) = True Then
        Soma = Soma + ListBoxFIADO.List(Item, 5)
    End If
Next
TextBoxTOTALFIADO = Format(Soma, "R$ #,##0.00")
    
End Sub

Dentro do envento MouseUp do ListBoxFiado cole este código:

Call Soma_Selecao

Uma dica, altere o local de armazenamento inicial da sua ID para que essa linha não apareça nos listbox, tanto na aba Base quanto na aba CONVENIÊNCIA, apenas questão de estética,  elas podem ser inicializadas em qualquer célula da planilha, K1 por exemplo, não precisa estar dentro da tabela.

RafaVillani

@Jefferson TSOlá, este erro ocorre por duas razões, primeiro porque você esta tentando filtrar as informação da aba BASE, quando deveria filtrar os dados da aba CONVENIÊNCIA, na Sub FiltroFiado substitua essa linha

Set base = Planilha1.Range("A4").CurrentRegion

por essa

Set base = Plan1.Range("A4").CurrentRegion

segundo porque você esta inserindo o nome do cliente na célula errada, a célula M2 da aba FILTRO_FIADO corresponde à quantidade, e não ao Cliente (Célula K2), dentro do comboboxCLIENTE_FIADO  substitua essa linha

Planilha5.Range("M2") = ComboBoxCLIENTE_FIADO.Value

por esta

Planilha5.Range("K2") = ComboBoxCLIENTE_FIADO.Value

Dessa forma irá funcionar.

RafaVillani

@paulocezarpicosSem problemas, precisando é só chamar!

@paulocezarpicosAcredito que não seja possível inserir um código VBA automaticamente após a inserção de uma nova aba na planilha (se é possível, eu desconheço).

O que eu aconselho você a fazer é deixar as planilhas fixas, 12 planilhas representando os meses do ano, janeiro, fevereiro...até dezembro, já com os códigos VBA, e uma outra planilha onde será feito o controle anual conforme as planilhas mensais. E um botão tipo reset para poder apagar as planilhas mensais ao final de cada ano. Se o cliente quiser analisar as leituras anteriores elas estarão nessa outra planilha disposta por ano e mês.

RafaVillani