none
Complemento de Registro

    Question

  •  

    Prezados,

     

    Uma ajuda.

    Estou montando um controle de contratos em excel com form criados a partir do vba.

    Tenho um form que faz os lançamentos dos contratos e que lança os dados em uma linha do excel (linha 1 da Plan1) ... A cada novo registro o form lança os dados referentes ao novo contrato na primeira linha vazia da Plan1 (tudo ok, funcionando).

    Criei um form de complemento onde eu tenho uma textbox que digitarei o codigo contrato e os demais campos a serem preenchidos.

    Ex.: colunas: contrato, data, valor (preenchidos pelo form de lançamentos) / colunas: cliente, produto (preenchidos pelo form de complemento).

    Como fazer para que os novos dados referente a um contrato ja existente continue na linha que ele ocupa e não caia na linha vazia abaixo ?

     

    Fabiano Lima.

     

     

    Monday, September 10, 2007 4:46 PM

Answers

  • Fabiano:

     

    Ao invés de percorrer as células, que prejudica demais a performance, faça o seguinte:

     

    'declara uma range 

    Dim rng As Range
    Dim linha As Long

     

    With Worksheets("Relação")
        .Cells(1, 1).Activate

     

    'Faça um find para buscar se existe o contrato (verifique os parametros).

    Set rng = Worksheets("Relação").Cells.Find(What:=TextContrato, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
           xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
            , SearchFormat:=False)
        

        'Se retornar uma range, isto é, se encontrar o registro, pega a linha encontrada
        If rng Is Nothing Then
            linha = Worksheets("Relação").UsedRange.Rows.Count + 1
        Else
            linha = rng.EntireRow.Row
        End If

        .Cells(linha, 1).Value = TextContrato.Value
        .Cells(linha, 2).Value = TextParticipante.Value
        .Cells(linha, 3).Value = ComboPosicao.Value
        .Cells(linha, 4).Value = TextContraparte.Value
        .Cells(linha, 5).Value = CheckGlobal.Value
        .Cells(linha, 6).Value = TextComando.Value
        .Cells(linha, 7).Value = TextValorBase.Value
        .Cells(linha, 8).Value = TextDataInicio.Value
        .Cells(linha, 9).Value = TextDataVecto.Value
        .Cells(linha, 10).Value = ComboMoeda.Value
        .Cells(linha, 11).Value = TextTaxaTermo.Value
        .Cells(linha, 12).Value = CheckCross.Value
        .Cells(linha, 13).Value = ComboFonte.Value
        .Cells(linha, 14).Value = ComboCotacao.Value
        .Cells(linha, 15).Value = ComboBoletim.Value

    End With

    Abs,

     

     

    Friday, October 19, 2007 4:59 PM

All replies

  • Voce quer que ele sobrescreva os dados!??!
    Monday, September 10, 2007 7:11 PM
  •  

    Não.

    Quero que os dados inseridos pelo outro form sejam incluidos na mesma linha, porem em colunas diferentes.

    Com o form Lançamento as celulas A, B e C serão preenchidas. Com o form Complemento seram preenchidas as celudas D, E e F. (da mesma linha). Onde minha referencia será o numero do contrato. O "sistema" deve "reconhecer" o textbox do form Complemento com o numero do contrato e lançar na mesma linha (excel) do respectivo contrato.

    Exemplo: Form Lançamento: preenche A1, A2 e A3 e Form Complemento preenche A4, A5 e A6 (sem mexer nos dados de A1, A2 e A3).

    Abs,

    Fabiano Lima

    Monday, September 10, 2007 7:56 PM
  • Os dados estão em que linguagem!?
    Monday, September 10, 2007 9:02 PM
  • Pregunta dificil rsrsrs

     

    Segue o codigo do Form de Lançamento (que está funcionando) .. acho que ajuda a responder a pergunta: 

     

     

     Private Sub Bt_OK_Click()
    Dim linha As Integer

    If CAtualizacao Then
        If MsgBox("Confirma Inclusão ?", vbYesNo, "Novo Registro") = vbNo Then
        Exit Sub
        End If
    End If

    With Worksheets("Relação")
    linha = .UsedRange.Rows.Count + 1
    .Cells(linha, 1).Value = TextContrato.Value
    .Cells(linha, 2).Value = TextParticipante.Value
    .Cells(linha, 3).Value = ComboPosicao.Value
    .Cells(linha, 4).Value = TextContraparte.Value
    .Cells(linha, 5).Value = CheckGlobal.Value
    .Cells(linha, 6).Value = TextComando.Value
    .Cells(linha, 7).Value = TextValorBase.Value
    .Cells(linha, 8).Value = TextDataInicio.Value
    .Cells(linha, 9).Value = TextDataVecto.Value
    .Cells(linha, 10).Value = ComboMoeda.Value
    .Cells(linha, 11).Value = TextTaxaTermo.Value
    .Cells(linha, 12).Value = CheckCross.Value
    .Cells(linha, 13).Value = ComboFonte.Value
    .Cells(linha, 14).Value = ComboCotacao.Value
    .Cells(linha, 15).Value = ComboBoletim.Value

    End With


    If AEfetuada Then
        MsgBox ("Inclusão Efetuada!")
    End If

    Limpar_Campos

    ThisWorkbook.Save
       


    End Sub

     

     

    Abs

     

    Fabiano Lima

    Monday, September 10, 2007 9:14 PM
  • Please .. alguem que possa me ajudar ?

     

    Fabiano Lima

    Wednesday, September 12, 2007 11:51 PM
  •  FabianoLima wrote:

    Pregunta dificil rsrsrs

     

    Segue o codigo do Form de Lançamento (que está funcionando) .. acho que ajuda a responder a pergunta: 

     

     

     Private Sub Bt_OK_Click()
    Dim linha As Integer

    If CAtualizacao Then
        If MsgBox("Confirma Inclusão ?", vbYesNo, "Novo Registro") = vbNo Then
        Exit Sub
        End If
    End If

    With Worksheets("Relação")
    linha = .UsedRange.Rows.Count + 1
    .Cells(linha, 1).Value = TextContrato.Value
    .Cells(linha, 2).Value = TextParticipante.Value
    .Cells(linha, 3).Value = ComboPosicao.Value
    .Cells(linha, 4).Value = TextContraparte.Value
    .Cells(linha, 5).Value = CheckGlobal.Value
    .Cells(linha, 6).Value = TextComando.Value
    .Cells(linha, 7).Value = TextValorBase.Value
    .Cells(linha, 8).Value = TextDataInicio.Value
    .Cells(linha, 9).Value = TextDataVecto.Value
    .Cells(linha, 10).Value = ComboMoeda.Value
    .Cells(linha, 11).Value = TextTaxaTermo.Value
    .Cells(linha, 12).Value = CheckCross.Value
    .Cells(linha, 13).Value = ComboFonte.Value
    .Cells(linha, 14).Value = ComboCotacao.Value
    .Cells(linha, 15).Value = ComboBoletim.Value

    End With


    If AEfetuada Then
        MsgBox ("Inclusão Efetuada!")
    End If

    Limpar_Campos

    ThisWorkbook.Save
       


    End Sub

     

     

    Abs

     

    Fabiano Lima

     

    Opa, acho que podemos ajudar sim Fabiano...

     

    Veja se a linha de código abaixo te ajuda em algo:

     

    Dim NumeroDeLinhas As Integer

    For NumeroDeLinhas = Range("A65536").End(xlUp).Row To 1 Step -1
        If Cells(NumeroDeLinhas, 1).Value = TextContrato.Value Then
            'quer dizer que encontrou o contrato à complementar dados! (= ao valor do campo TextContrato do Form Complementar)
            Cells(NumeroDeLinhas,16).Value = "Valor do Primeiro Complemento na Coluna 16"
            Cells(NumeroDeLinhas, 17).Value = "Valor do Segundo Complemento na Coluna 17"
        End If
    Next NumeroDeLinhas

     

    O que acontece na linha de código acima eh que o excel percorre dado por dado da coluna A (das células que estão preenchidas) e quando encontra um contrato com determinado número igual ao seu campo TextContrato do Formulário Complementar, determina que os valores da Coluna 16 e 17 sejam preenchidos com respectivo valor.

     

    Tranquilo?

    Qualquer dúvida retorne,

     

    Abraços!

    Tuesday, September 25, 2007 1:52 AM
  •  

    Caro Skyz!n,l

     

    Muito obrigado pela dica.

    Ajudou e muito.

     

    Fabiano Lima.

    Wednesday, September 26, 2007 4:15 PM
  • Skyz!n,

     

    Cara só uma coisa:

    Se eu digito o número de um contrato ja cadastrado o código acima funciona normalmente. Mas se eu deixar o texbox vazio, o codigo pára na primeira célula vaiza que ele encontrar .. como ignorar células vazias ?

    Eu coloquei algo do tipo:

     if tetxbox = "" then

    msgbox "Digite o número do contato"

    end if

    Mas como o codigo anterior determina que se o valor da textbox for encontra, complemente as linhas 16 e 17 o sistema fica dando um loop sem fim (devido ao next) e acava travando.

    Como posso resolver ?

    Fabiano Lima.

    Tuesday, October 16, 2007 3:21 PM
  • Fabiano:

     

    Ao invés de percorrer as células, que prejudica demais a performance, faça o seguinte:

     

    'declara uma range 

    Dim rng As Range
    Dim linha As Long

     

    With Worksheets("Relação")
        .Cells(1, 1).Activate

     

    'Faça um find para buscar se existe o contrato (verifique os parametros).

    Set rng = Worksheets("Relação").Cells.Find(What:=TextContrato, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
           xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
            , SearchFormat:=False)
        

        'Se retornar uma range, isto é, se encontrar o registro, pega a linha encontrada
        If rng Is Nothing Then
            linha = Worksheets("Relação").UsedRange.Rows.Count + 1
        Else
            linha = rng.EntireRow.Row
        End If

        .Cells(linha, 1).Value = TextContrato.Value
        .Cells(linha, 2).Value = TextParticipante.Value
        .Cells(linha, 3).Value = ComboPosicao.Value
        .Cells(linha, 4).Value = TextContraparte.Value
        .Cells(linha, 5).Value = CheckGlobal.Value
        .Cells(linha, 6).Value = TextComando.Value
        .Cells(linha, 7).Value = TextValorBase.Value
        .Cells(linha, 8).Value = TextDataInicio.Value
        .Cells(linha, 9).Value = TextDataVecto.Value
        .Cells(linha, 10).Value = ComboMoeda.Value
        .Cells(linha, 11).Value = TextTaxaTermo.Value
        .Cells(linha, 12).Value = CheckCross.Value
        .Cells(linha, 13).Value = ComboFonte.Value
        .Cells(linha, 14).Value = ComboCotacao.Value
        .Cells(linha, 15).Value = ComboBoletim.Value

    End With

    Abs,

     

     

    Friday, October 19, 2007 4:59 PM
  • Conforme sugestão acima, o Find é bem mais rápido que um loop linha a linha. Em planilhas pequenas a diferença não é perceptível, mas em planilhas maiores sim.

     

    Sunday, October 21, 2007 2:55 PM
    Moderator
  • Prezados,

     

    A dica serviu bastante.

    Obrigado a todos.

     

    Fabiano Lima

    Monday, October 22, 2007 9:09 PM