Felipe,

Veja se o anexo atende sua necessidade.
Espero ter ajudado.

Abraço

Felipe,

Veja se o anexo atende sua necessidade.
Espero ter ajudado.

Abraço

Mt Obrigado chará !! Ficou Exatamente como eu queria !!

Agora Vou tentar analisar o seu código para tentar entende, pois o próximo passo é fazer o botão restaurar funcionar..
Assim que acabar de analisar vou postar novamente.

Abs

Felipe,

Veja se o anexo atende sua necessidade.
Espero ter ajudado.

Abraço

Estava acostumado com a linguagem do VBA integrado a planilha, nunca tinha feito direto com formulário, pelo que ví você usa uma programação bem mais avançada
Vamos as Dúvidas:
1 - Sempre que você vai pegar algum dado do "banco de dados" você se refere a [Plan8], não entendi isso, o nome da planilha é BDORCAMENTOS.
2 - Quando você usa o código: "endereco = GetEndereco(selecao)", como que ele sabe que ele deve procurar entre B2 até (UltimaColuna)2 ? Pelo que entendi +- foi através da Private Function GetEndereco(ByVal selecao As String) As String, certo ? Caso sim, ví que vc declarou: [Plan8].[b2], ou seja a planilha que é usada para Banco de dados (novamente Plan8 que não entendi), de B2 (blz) até XFD2 (que não entendi).

Minhas Dúvidas eram essas, para finalizar a função ao apertar restaurar, gostaria que executasse o código do módulo1, Sub orcamentocadastro()

Sendo que o valor da variável "coluna" nesse código deve receber o número da coluna selecionado da descrição (A=1, B=2, C=3, etc), com isso o código vai restaurar a coluna que corresponde com a descrição selecionada.

Segue novo anexo, pois tive que fazer alterações no código que serve para restaurar para poder funcionar isso.

Muito Obrigado mais uma vez pela sua atenção, o código que você desenvolveu ficou 10 !!

Felipe,

No Project Explorer (Ctrl+R) você tem acesso a todas as planilhas do arquivo.
Uma delas era Plan8(BDORCAMENTOS).

[plan8] é o equivalente a Worksheets("BDORCAMENTOS"), mas no primeiro caso o usuário pode modificar o nome da aba sem prejudicar o algoritmo.

Sim, esse comando chama o GetEndereco passando como argumento o objeto selecionado no ListBox.
Como o parâmetro está na linha 2, e a primeira coluna não conta, usei [Plan8].[b2] para definir uma seleção entre B2 e XFD2, onde XFD é a última coluna do excel e 2 é o filtro da linha desejada.

Para chamar um algoritmo use a instrução call nomeAlgoritmo()
Assim, o comando restaurar ficou:

Private Sub cmd_restaurar_Click()
    
 Dim col As Integer
    
'    Selecionar Plan8.Selecionar Células(Buscar endereço do valor selecionado no ListBox).Retornar número da coluna.
    col = [Plan8].Range(GetEndereco(lbx_selecione.Value)).Column
    Call orcamentooderlist(col)
    
End Sub

E um parâmetro foi adicionado no seu algoritmo: Sub orcamentooderlist(coluna As Integer)

Veja se isso lhe ajuda.
Apareço aqui só de noite devido ao trampo e faculdade, mas vou responder todas as dúvidas que estiverem ao meu alcance.

Abraço

Felipe,

No Project Explorer (Ctrl+R) você tem acesso a todas as planilhas do arquivo.
Uma delas era Plan8(BDORCAMENTOS).

[plan8] é o equivalente a Worksheets("BDORCAMENTOS"), mas no primeiro caso o usuário pode modificar o nome da aba sem prejudicar o algoritmo.

Sim, esse comando chama o GetEndereco passando como argumento o objeto selecionado no ListBox.
Como o parâmetro está na linha 2, e a primeira coluna não conta, usei [Plan8].[b2] para definir uma seleção entre B2 e XFD2, onde XFD é a última coluna do excel e 2 é o filtro da linha desejada.

Para chamar um algoritmo use a instrução call nomeAlgoritmo()
Assim, o comando restaurar ficou:

Private Sub cmd_restaurar_Click()
    
 Dim col As Integer
    
'    Selecionar Plan8.Selecionar Células(Buscar endereço do valor selecionado no ListBox).Retornar número da coluna.
    col = [Plan8].Range(GetEndereco(lbx_selecione.Value)).Column
    Call orcamentooderlist(col)
    
End Sub

E um parâmetro foi adicionado no seu algoritmo: Sub orcamentooderlist(coluna As Integer)

Veja se isso lhe ajuda.
Apareço aqui só de noite devido ao trampo e faculdade, mas vou responder todas as dúvidas que estiverem ao meu alcance.

Abraço

Cara, muito bom, consegui adaptar a minha planilha completa, vou tirar os próximos dias para tentar analisar e entender tudo que você desenvolveu, não sei se no formulário é muito diferente, mais o código que você desenvolve é bem diferente do que eu estava "acostumado", ficou perfeito mais uma vez !!!
Para finalizar esse tópico só gostaria de resolver mais 3 pequenas funções
1- Eu adicionei no botão de restaurar o comando: Application.ScreenUpdating = False para não mostrar passo passo as macros sendo feitas e agilizar o processamento, só que notei que depois que acaba, por trás da janela do formulário fica tudo congela, parecendo que o código não funcionou, apenas depois de eu fechar que é atualizada a tela, tem como assim que acabar de executar o código já atualizar a tela por trás do formulário para não ficar com impressão de "congelado" ?
2 - Na exibição do ListView, tem como mostrar os últimos rascunhos salvos primeiro ficando na ordem de mais recentes(a cima) aos mais velhos (a baixo), uma forma "fácil" do sistema saber qual é mais antigo ou novo é utilizando o código que fica na linha 1 de BDORCAMENTOS (quanto mais alto o código mais recente).
3 - Por ultimo, é um pequeno bug, por exemplo, na hora de salvar um novo orçamento a pessoa digitar um nome que já tenha no banco de dados (ex: teste), ele irá salvar normalmente, porém ao abrir o formulário, aparecerá duas descrições teste e ambos com os mesmo dados (do registro mais antigo), gostaria que ao salvar com uma descrição com o mesmo nome o mesmo substituísse a coluna mais antiga pela nova.

É Isso, com isso o Formulário/planilha vai ficar perfeito.

Segue planilha atualizada 100% funcional com a ajuda do seu código em anexo.

Um grande abraço,
Felipe

Felipe,

Tente adicionar adicionar Application.ScreenUpdating = True no final do seu algoritmo para sanar o item 1.

Quanto ao item 2, fiz com o que o algoritmo carregasse o Listbox na ordem inversa, então modifiquei a instrução:

 
'   TRANSFERIR OS DADOS DO VETOR PARA O LISTBOX
    For Each f In fonte
        lbx_selecione.AddItem f
    Next f

Para a instrução

'   
    TRANSFERIR OS DADOS DO VETOR PARA O LISTBOX
    For i = UBound(fonte) To 0 Step -1
        lbx_selecione.AddItem fonte(i)
    Next i

Por fim, criei o algoritmo para remoção de descrições duplicadas. Procurei gerar um código bem limpo para facilitar a interpretação.
Adicionei alguns comentários para facilitar. Em resumo, coloquei em ordem inversa todas as descrições no objeto Collection, como ele não aceita duplicidade, a cada erro gerado significa que a descrição é repetida e deve ser deletada.

Sub RemoverDuplicidade()

'   NOME: REMOVER DUPLICIDADE

    Dim database As Range
    Dim descricao As Range
    Dim descricoes As Range
    Dim NaoRepetidos As New Collection

    Set database = [Plan8].[B2:XFD2]
    Set descricoes = database.SpecialCells(xlCellTypeConstants)

'   INÍCIO
'   ------------------------------------------------------------------------
    On Error Resume Next
       
    With descricoes
        
    '   PASSAR POR TODAS AS DESCRIÇÕES DE TRAZ PARA FRENTE
        For i = .Columns.Count To 1 Step -1
        
            Err = 0
            NaoRepetidos.Add .Cells(i), .Cells(i)
            
        '   SE ERRO, ENTÃO DELETAR PORQUE É UM VALOR DUPLICADO
            If Err > 0 Then .Cells(i).EntireColumn.Delete
            
        Next i
    End With

    On Error GoTo 0
    
End Sub

Agora seu algoritmo para salvar o orçamento tem que receber uma nova instrução de chamada:

Private Sub cmd_salvarorcamento_Click()
    Application.ScreenUpdating = False
    Call Módulo1.gravarorcamento
    Call RemoverDuplicidade
    Application.ScreenUpdating = True
End Sub

Veja se isso ajuda.
O texto acabou ficando grande porque, como percebi que você gosta de entender o que foi feito, achei melhor destacar as modificações.

Abraço

Tudo funcionando perfeitamente, sem sua ajuda eu levaria 1 mês e provavelmente não teria conseguido concluir esse código, ficou sensacional !!! Tudo funcionando redondo, já implementei tudo na minha planilha principal.

Uma ultima dúvida:
Na hora de gravar o orçamento abre um imputbox com o campo em branco, gostaria de ao invés de ficar em branco aparecer o nome da ultima descrição que salvei, dai eu decido se simplesmente salvo por cima ou mudo a descrição.

Segue código:

Sub gravarorcamento()
Dim lastRow As Long, Variavel As Integer, LastCol As Long, qtdprodutos As Long, Data As String, resposta As String

Application.EnableEvents = False
Range("B7").Value = Range("B7").Value + 1
Variavel = Range("B7").Value
Data = Format(DateTime.Now, "dd/mm/yyyy - hh:mm:ss")
' Aqui
resposta = InputBox("Descrição do Orçamento", "Entrada de Dados")
' Aqui
If resposta = Empty Then

Else
 With ActiveSheet
    lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    ActiveSheet.Cells(.Rows.Count, 1).End(xlUp).EntireRow.Select
qtdprodutos = ActiveCell.Offset(1, 5)
 End With
 Range("C22", Cells(lastRow, 3)).Copy
 Sheets("BDORCAMENTOS").Select
 
 
    With ActiveSheet
        LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
        LastCol = LastCol + 1
    End With
    
  Range(Cells(6, LastCol), Cells(6, LastCol)).Select
    Selection.ColumnWidth = 32.01
    ActiveSheet.Paste
    Range(Cells(1, LastCol), Cells(1, LastCol)) = Variavel
    Range(Cells(2, LastCol), Cells(2, LastCol)) = resposta
    Range(Cells(3, LastCol), Cells(3, LastCol)) = Data
    Range(Cells(4, LastCol), Cells(4, LastCol)) = lastRow - 21
    Range(Cells(5, LastCol), Cells(5, LastCol)) = qtdprodutos
    Sheets("Cadastro").Select
    lastRow = lastRow
    Range("F22", Cells(lastRow, 6)).Copy
    Sheets("BDORCAMENTOS").Select
    lastRow = lastRow - 21
    ActiveCell.Offset(lastRow, 0).Range("A1").Select
    ActiveSheet.Paste
   Range(Cells(1, LastCol), Cells(5, LastCol)).Select
    With Selection
        .HorizontalAlignment = xlLeft
    End With
    
Sheets("Cadastro").Select
Application.EnableEvents = True

End If
End Sub

É isso, ficou melhor do que eu esperava, tenho certeza que esse código será muito interessante para muitos usuários que desejem restaurar/gravar uma lista para orçamento.

Abs !!

Consegui Resolver, só não foi uma solução bonita:

Segue novo código:

Sub gravarorcamento()
Dim lastRow As Long, Variavel As Integer, LastCol As Long, qtdprodutos As Long, Data As String, resposta As String, ultimaresposta As String

Application.EnableEvents = False
Range("B7").Value = Range("B7").Value + 1
Variavel = Range("B7").Value
ultimaresposta = Range("A7").Value
Data = Format(DateTime.Now, "dd/mm/yyyy - hh:mm:ss")

resposta = InputBox("Descrição do Orçamento", "Entrada de Dados", ultimaresposta)
Range("A7").Value = resposta
If resposta = Empty Then

Else

 With ActiveSheet
    lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    ActiveSheet.Cells(.Rows.Count, 1).End(xlUp).EntireRow.Select
qtdprodutos = ActiveCell.Offset(1, 5)
 End With
 Range("C22", Cells(lastRow, 3)).Copy
 Sheets("BDORCAMENTOS").Select

 
    With ActiveSheet
        LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
        LastCol = LastCol + 1
    End With
    
  Range(Cells(6, LastCol), Cells(6, LastCol)).Select
    Selection.ColumnWidth = 32.01
    ActiveSheet.Paste
    Range(Cells(1, LastCol), Cells(1, LastCol)) = Variavel
    Range(Cells(2, LastCol), Cells(2, LastCol)) = resposta
    Range(Cells(3, LastCol), Cells(3, LastCol)) = Data
    Range(Cells(4, LastCol), Cells(4, LastCol)) = lastRow - 21
    Range(Cells(5, LastCol), Cells(5, LastCol)) = qtdprodutos
    Sheets("Cadastro").Select
    lastRow = lastRow
    Range("F22", Cells(lastRow, 6)).Copy
    Sheets("BDORCAMENTOS").Select
    lastRow = lastRow - 21
    ActiveCell.Offset(lastRow, 0).Range("A1").Select
    ActiveSheet.Paste
   Range(Cells(1, LastCol), Cells(5, LastCol)).Select
    With Selection
        .HorizontalAlignment = xlLeft
    End With
    
Sheets("Cadastro").Select
Application.EnableEvents = True

End If
End Sub

ou seja:
Mudei de

resposta = InputBox("Descrição do Orçamento", "Entrada de Dados")

para

ultimaresposta = Range("A7").Value
resposta = InputBox("Descrição do Orçamento", "Entrada de Dados", ultimaresposta)
Range("A7").Value = resposta

ou seja adicionou a resposta após gravar um orçamento em uma célula (A7) na guia cadastro (pintei de branco para ficar invisivel) e quando for executar da próxima vez ele lê esse dado que ficou armazenado na célula A7 e grava na variável ultimaresposta que é apresentado no imputbox.

Se tiver uma solução que não precise gravar valor na célula ficaria grato pois poderia evitar problemas no futuro..

Abs

Felipe,

Aqui vai minha sugestão.

'    DECLARA O OBJETO
    Dim ultimaresposta As Range

'    CRIA O OBJETO
    Set ultimaresposta = [Plan8].[XFD2].End(xlToLeft)

'    RETORNA EM BRANCO NA AUSÊNCIA DE DESCRIÇÕES NO BANCO DE DADOS.
    If ultimaresposta.Column = 1 Then ultDescricao = ""

Esse comando vai no banco de dados, seleciona a última coluna da linha 2, desloca para a esquerda até achar a última célula preenchida e cria uma referência a ela.
Depois me certifico de que a coluna não é a primeira.

Agora basta usar a variável no seu InputBox

Abraço

Felipe, para variar um pouquinho perfeito. Funcionando ainda melhor do que o improviso que tinha feito pois agora retorna o ultimo valor da coluna, pois se eu antes salvava orçamento teste2 e depois apagasse, quando eu ia gravar um novo orçamento aparecia teste2, agora aparece o ultimo salvo (teste1 por exemplo). Ficou muito bom.
Muito obrigado por tudo.

Vou finalmente por como resolvido o tópico.

Abs