Notifications

Clear all

Gerar códigos a cada novo cadastro

Página 2 / 2 Anterior

2024 - VBA & Macros

Post Recente por Paulo_001 12 anos atrás

27 Posts

2 Usuários

0 Reactions

3,441 Visualizações

RSS

Paulo_001

(@paulo_001)

Posts: 149

Estimable Member

Topic starter

Olá, Tenho uma planilha onde lanço novos cadastros diariamente, e gostaria de saber como gerar um código pra esse cadastro com as seguintes condições.
A coluna A é responsável pelos códigos e as outras pelo restante.
Então como eu faço pra se a célula da coluna B for diferente de vazio, aparecer na coluna A um número subsequente do maior já preenchido ?

Detalhe, os nomes da coluna B são organizados em ordem alfabética, portanto, os números que ficam na coluna A referentes ao nomes, ficam bagunçados.

Postado : 12/04/2013 6:17 pm

Paulo_001

(@paulo_001)

Posts: 149

Estimable Member

Topic starter

Alguém conhece alguma maneira de deixar o código do cadastro "preso" ao nome de maneira que ao organizar os nomes por ordem alfabética, o código referente ao cadastro não se embaralhe. Nas minhas o nome vai, mas o numero fica =D

Postado : 16/04/2013 12:21 pm

Fernando Fernandes

(@fernandofernandes)

Posts: 43750

Illustrious Member

Para que o numero acompanhe os nomes na hora de ordenar, a coluna do codigo deve ser incluida no range da ordem
.....SetRange Range("A2:N" & lRow)

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

Postado : 16/04/2013 12:27 pm

Paulo_001

(@paulo_001)

Posts: 149

Estimable Member

Topic starter

wow! era só trocar uma letra?!

Desde que comecei a entrar na parte de VBA, descobri que sou mais burro do que imaginava. :/

Postado : 16/04/2013 1:13 pm

Paulo_001

(@paulo_001)

Posts: 149

Estimable Member

Topic starter

Vou disponibilizar essa planilha para a pessoal da portaria que possui nenhuma, ou quase nenhuma noção de computação.
Mas do jeito que está ficando qualquer pessoa vai poder trabalhar com ela.

Vocês aqui do Fórum são simplesmente sensacionais!

Postado : 16/04/2013 1:19 pm

Paulo_001

(@paulo_001)

Posts: 149

Estimable Member

Topic starter

Private Sub btnConcluir_Click()

Dim saida As Date
saida = Time

UltimaLinha = Plan1.Range("A3000").End(xlUp).Row
Cells(UltimaLinha, 8).Select

linhaatual = UltimaLinha

Do While ActiveCell.Value <> "saída"
linhaatual = ActiveCell.Row
Dim entrada As Date
If Range("G" & linhaatual).Value <> "" And Range("G" & linhaatual).Value <> "?????" Then
entrada = Range("G" & linhaatual).Text
End If

If Cells(linhaatual, 1) = txtSem.Text And Cells(linhaatual, 2) = txtDia.Text And Cells(linhaatual, 3) = txtCod.Text And Cells(linhaatual, 4) = txtVisitante.Text And Cells(linhaatual, 5) = txtIdentificacao.Text And Cells(linhaatual, 6) = txtplaca.Text And entrada = txtEntrada.Text And Cells(linhaatual, 9) = txtMorador.Text And Cells(linhaatual, 10) = txtNum.Text Then
Cells(linhaatual, 8).Value = saida
MsgBox "Horario de saída: " & saida
End If

ActiveCell.Offset(-1, 0).Select
Loop


btnConcluir.Enabled = False

ListView1.ListItems.Clear
Call Preenchelist

txtSem = ""
txtDia = ""
txtCod = ""
txtVisitante = ""
txtIdentificacao = ""
txtplaca = ""
txtEntrada = ""
txtMorador = ""
txtNum = ""

End Sub

Private Sub ListView1_Click()
        txtSem = ListView1.SelectedItem
       txtDia = ListView1.SelectedItem.ListSubItems.Item(1)
       txtCod = ListView1.SelectedItem.ListSubItems.Item(2)
       txtVisitante = ListView1.SelectedItem.ListSubItems.Item(3)
       txtIdentificacao = ListView1.SelectedItem.ListSubItems.Item(4)
       txtplaca = ListView1.SelectedItem.ListSubItems.Item(5)
       txtEntrada = ListView1.SelectedItem.ListSubItems.Item(6)
       txtMorador = ListView1.SelectedItem.ListSubItems.Item(8)
       txtNum = ListView1.SelectedItem.ListSubItems.Item(9)
       
       btnConcluir.Enabled = True
End Sub

Sub Preenchelist()
    Dim itens As ListItem
    Dim lastRow As Long
    Dim x As Long
    
    
    lastRow = Plan1.Range("A1000").End(xlUp).Row
    
    'Cria o cabeçalho
    With ListView1
        .ColumnHeaders.Clear
        .Gridlines = True
        .View = lvwReport
        .ListItems.Clear
        .FullRowSelect = True
        
        .ColumnHeaders.Add Text:="Sem", Width:="25"
        .ColumnHeaders.Add Text:="Dia", Width:="40"
        .ColumnHeaders.Add Text:="Cod", Width:="40"
        .ColumnHeaders.Add Text:="Visitante", Width:="100"
        .ColumnHeaders.Add Text:="Identificação", Width:="80"
        .ColumnHeaders.Add Text:="Placa do Veículo", Width:="60"
        .ColumnHeaders.Add Text:="Entrada", Width:="50"
        .ColumnHeaders.Add Text:="Saída", Width:="50"
        .ColumnHeaders.Add Text:="Morador", Width:="40"
        .ColumnHeaders.Add Text:="Número", Width:="40"
        .ColumnHeaders.Add Text:="Situação", Width:="50"

        
    End With
    
    ' Ciclo em todas as linhas
    For x = 2 To lastRow
    
    If Cells(x, 11).Value = "Presente" Then
    
        'PREENCHENDO O LISTVIEW
        Set itens = Me.ListView1.ListItems.Add(, , Plan1.Cells(x, 1).Value)
           
            itens.SubItems(1) = Plan1.Cells(x, 2).Value
            itens.SubItems(2) = Plan1.Cells(x, 3).Value
            itens.SubItems(3) = Plan1.Cells(x, 4).Value
            itens.SubItems(4) = Plan1.Cells(x, 5).Value
            itens.SubItems(5) = Plan1.Cells(x, 6).Value
            itens.SubItems(6) = Plan1.Cells(x, 7).Text
            itens.SubItems(7) = Plan1.Cells(x, 8).Value
            itens.SubItems(8) = Plan1.Cells(x, 9).Value
            itens.SubItems(9) = Plan1.Cells(x, 10).Value
            itens.SubItems(10) = Plan1.Cells(x, 11).Value
    End If
            
    Next
End Sub


Private Sub UserForm_Initialize()
Sheets("Controle").Select
Call Preenchelist
End Sub

Galera, esse código é da listview. Ela pula pra planilha banco.

Há como ela permanecer somente na plan1?
Tentei fazer algumas alterações, mas o resultado não foi bom não.

Postado : 16/04/2013 1:24 pm

Fernando Fernandes

(@fernandofernandes)

Posts: 43750

Illustrious Member

No evento de inicialização do formulario altere para:

Private Sub UserForm_Initialize()
    Call Preenchelist
End Sub

No Preenchelist:

Sub Preenchelist()
    Dim itens As ListItem
    Dim lastRow As Long
    Dim x As Long
    
    
    lastRow = Sheets("Controle").Cells(Cells.Rows.Count, "D").End(xlUp).Row
    
    'Cria o cabeçalho
    With ListView1
        .ColumnHeaders.Clear
        .Gridlines = True
        .View = lvwReport
        .ListItems.Clear
        .FullRowSelect = True
        
        .ColumnHeaders.Add Text:="Sem", Width:="40"
        .ColumnHeaders.Add Text:="Dia", Width:="60"
        .ColumnHeaders.Add Text:="Cod", Width:="40"
        .ColumnHeaders.Add Text:="Visitante"
        .ColumnHeaders.Add Text:="Identificação"
        .ColumnHeaders.Add Text:="Placa do Veículo"
        .ColumnHeaders.Add Text:="Entrada", Width:="50"
        .ColumnHeaders.Add Text:="Saída"
        .ColumnHeaders.Add Text:="Morador", Width:="40"
        .ColumnHeaders.Add Text:="Número", Width:="40"
        .ColumnHeaders.Add Text:="Situação", Width:="50"

        
    End With
    
    ' Ciclo em todas as linhas
With Sheets("Controle")
    For x = 2 To lastRow
    
    If .Cells(x, 11).Value = "Presente" Then
        'PREENCHENDO O LISTVIEW
        Set itens = Me.ListView1.ListItems.Add(, , .Cells(x, 1).Value)
           
            itens.SubItems(1) = .Cells(x, 2).Value
            itens.SubItems(2) = .Cells(x, 3).Value
            itens.SubItems(3) = .Cells(x, 4).Value
            itens.SubItems(4) = .Cells(x, 5).Value
            itens.SubItems(5) = .Cells(x, 6).Value
            itens.SubItems(6) = .Cells(x, 7).Text
            itens.SubItems(7) = .Cells(x, 8).Value
            itens.SubItems(8) = .Cells(x, 9).Value
            itens.SubItems(9) = .Cells(x, 10).Value
            itens.SubItems(10) = .Cells(x, 11).Value
    End If            
    Next
End With
End Sub

Não testei, mas creio que a rotina --> btnConcluir_Click <-- deve ser alterada tb; o lque espera que essa rotina faça??

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

Postado : 16/04/2013 2:05 pm

Paulo_001

(@paulo_001)

Posts: 149

Estimable Member

Topic starter

Não testei, mas creio que a rotina --> btnConcluir_Click <-- deve ser alterada tb; o lque espera que essa rotina faça??

Ela coloca o horário de saída nos cadastros que estão presentes.
No caso eu seleciono um nome da Listview e clico em concluir, ai na planilha Controle é colocado o horário de saída.

Postado : 16/04/2013 2:23 pm

Paulo_001

(@paulo_001)

Posts: 149

Estimable Member

Topic starter

ActiveCell.Offset(-1, 0).Select
Loop

No btnconcluir_Click foi essa linha pro depurador.

Postado : 16/04/2013 2:29 pm

Fernando Fernandes

(@fernandofernandes)

Posts: 43750

Illustrious Member

Veja se atende

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

Postado : 17/04/2013 5:34 am

Paulo_001

(@paulo_001)

Posts: 149

Estimable Member

Topic starter

Boa tarde Reinaldo

Agora fiquei confuso, ao apertar o concluir apenas os dados da listview são limpos, porém na planilha controle o visitante fica como "presente" ainda, não é marcado a saída na coluna H da planilha controle.

Postado : 17/04/2013 12:10 pm

Paulo_001

(@paulo_001)

Posts: 149

Estimable Member

Topic starter

[code]Private Sub btnConcluir_Click()
Application.ScreenUpdating = False
Sheets("Controle").Select

Dim saida As Date
saida = Time

UltimaLinha = Plan1.Range("A3000").End(xlUp).Row
Cells(UltimaLinha, 8).Select

linhaatual = UltimaLinha

Do While ActiveCell.Value <> "saída"
linhaatual = ActiveCell.Row
Dim entrada As Date
If Range("G" & linhaatual).Value <> "" And Range("G" & linhaatual).Value <> "?????" Then
entrada = Range("G" & linhaatual).Text
End If

If Cells(linhaatual, 1) = txtSem.Text And Cells(linhaatual, 2) = txtDia.Text And Cells(linhaatual, 3) = txtCod.Text And Cells(linhaatual, 4) = txtVisitante.Text And Cells(linhaatual, 5) = txtIdentificacao.Text And Cells(linhaatual, 6) = txtplaca.Text And entrada = txtEntrada.Text And Cells(linhaatual, 9) = txtMorador.Text And Cells(linhaatual, 10) = txtNum.Text Then
Cells(linhaatual, 8).Value = saida
MsgBox "Horario de saída: " & saida
End If
ActiveCell.Offset(-1, 0).Select

Loop



btnConcluir.Enabled = False

ListView1.ListItems.Clear
Call Preenchelist

txtSem = ""
txtDia = ""
txtCod = ""
txtVisitante = ""
txtIdentificacao = ""
txtplaca = ""
txtEntrada = ""
txtMorador = ""
txtNum = ""
Sheets("Plan1").Select
Application.ScreenUpdating = True
End Sub

Que bacana!
Consegui resolver, foi meio no chute, mas deu certinho vou disponibilizar a planilha pra quem for iniciar um projeto parecido, tirar algum proveito.