Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Gravar dados SE... ...
 
Notifications
Clear all

Gravar dados SE... (código muito grande)

 
2024 - VBA & Macros
Post Recente por bilokas 11 anos atrás
8 Posts
2 Usuários
0 Reactions
1,138 Visualizações
RSS
 bilokas
(@bilokas)
Posts: 168
Reputable Member
Topic starter
 

Galera gostaria de pedir a ajuda de vocês num projeto que estou desenvolvendo aqui, eu tenho o seguinte código para procurar linhas e gravar os dados:

Private Sub btn_Cadastrar_Click()
Dim lin As Integer

If Range("A3") = "" Then
lin = 3
    Else
    Range("A1").Select
    Selection.End(xlDown).Select
    lin = ActiveCell.Row + 1
End If

Sheets("contrato").Cells(lin, 41).Value = Me.txt_T_Numero.Value & "/" & Me.txt_T_Ano.Value
    Sheets("contrato").Cells(lin, 42).Value = Me.txt_T_Processo.Value
    Sheets("contrato").Cells(lin, 43).Value = Me.txt_T_Beneficiario.Value
    Sheets("contrato").Cells(lin, 44).Value = Me.cbo_T_Modalidade.Value
    Sheets("contrato").Cells(lin, 45).Value = Me.txt_T_Objeto.Value
    Sheets("contrato").Cells(lin, 46).Value = Me.txt_T_Observacao.Value
    
    Sheets("contrato").Cells(lin, 47).Value = Me.DTPicker_T_DataInicio.Value
    Sheets("contrato").Cells(lin, 48).Value = Me.DTPicker_T_DataTermino.Value
    
    Sheets("contrato").Cells(lin, 49).Value = Me.txt_T_ValorMensal.Value
    Sheets("contrato").Cells(lin, 50).Value = Me.txt_T_ValorGlobal.Value
    Sheets("contrato").Cells(lin, 51).Value = Me.txt_T_Situacao.Value
    
    If txt_T_Anexo01.Value <> "" Then
        Sheets("contrato").Cells(lin, 52).Value = ThisWorkbook.Path & "" & "ANEXO 01 - TERMO ADITIVO REFERENTE CONTRATO " & txt_TRC_Numero & txt_TRC_Ano & ".pdf"
            FileCopy txt_T_Anexo01.Text, Sheets("contrato").Cells(lin, 52).Value
    End If

     If txt_T_Anexo02.Value <> "" Then
        Sheets("contrato").Cells(lin, 53).Value = ThisWorkbook.Path & "" & "ANEXO 02 - TERMO ADITIVO REFERENTE CONTRATO " & txt_TRC_Numero & txt_TRC_Ano & ".pdf"
            FileCopy txt_T_Anexo02.Text, Sheets("contrato").Cells(lin, 53).Value
    End If
   
    If txt_T_Anexo03.Value <> "" Then
        Sheets("contrato").Cells(lin, 54).Value = ThisWorkbook.Path & "" & "ANEXO 03 - TERMO ADITIVO REFERENTE CONTRATO " & txt_TRC_Numero & txt_TRC_Ano & ".pdf"
            FileCopy txt_T_Anexo03.Text, Sheets("contrato").Cells(lin, 54).Value
    End If
        
    If txt_T_Anexo04.Value <> "" Then
        Sheets("contrato").Cells(lin, 55).Value = ThisWorkbook.Path & "" & "ANEXO 04 - TERMO ADITIVO REFERENTE CONTRATO " & txt_TRC_Numero & txt_TRC_Ano & ".pdf"
            FileCopy txt_T_Anexo04.Text, Sheets("contrato").Cells(lin, 55).Value
    End If
        
    If txt_T_Anexo05.Value <> "" Then
        Sheets("contrato").Cells(lin, 56).Value = ThisWorkbook.Path & "" & "ANEXO 05 - TERMO ADITIVO REFERENTE CONTRATO " & txt_TRC_Numero & txt_TRC_Ano & ".pdf"
            FileCopy txt_T_Anexo05.Text, Sheets("contrato").Cells(lin, 56).Value
    End If
        
    If txt_T_Anexo06.Value <> "" Then
        Sheets("contrato").Cells(lin, 57).Value = ThisWorkbook.Path & "" & "ANEXO 06 - TERMO ADITIVO REFERENTE CONTRATO " & txt_TRC_Numero & txt_TRC_Ano & ".pdf"
            FileCopy txt_T_Anexo06.Text, Sheets("contrato").Cells(lin, 57).Value
    End If
        
    If txt_T_Anexo07.Value <> "" Then
        Sheets("contrato").Cells(lin, 58).Value = ThisWorkbook.Path & "" & "ANEXO 07 - TERMO ADITIVO REFERENTE CONTRATO " & txt_TRC_Numero & txt_TRC_Ano & ".pdf"
            FileCopy txt_T_Anexo07.Text, Sheets("contrato").Cells(lin, 58).Value
    End If
        
    If txt_T_Anexo08.Value <> "" Then
        Sheets("contrato").Cells(lin, 59).Value = ThisWorkbook.Path & "" & "ANEXO 08 - TERMO ADITIVO REFERENTE CONTRATO " & txt_TRC_Numero & txt_TRC_Ano & ".pdf"
            FileCopy txt_T_Anexo08.Text, Sheets("contrato").Cells(lin, 59).Value
    End If
        
    If txt_T_Anexo09.Value <> "" Then
        Sheets("contrato").Cells(lin, 60).Value = ThisWorkbook.Path & "" & "ANEXO 09 - TERMO ADITIVO REFERENTE CONTRATO " & txt_TRC_Numero & txt_TRC_Ano & ".pdf"
            FileCopy txt_T_Anexo09.Text, Sheets("contrato").Cells(lin, 60).Value
    End If
        
    If txt_T_Anexo10.Value <> "" Then
        Sheets("contrato").Cells(lin, 61).Value = ThisWorkbook.Path & "" & "ANEXO 10 - TERMO ADITIVO REFERENTE CONTRATO " & txt_TRC_Numero & txt_TRC_Ano & ".pdf"
            FileCopy txt_T_Anexo10.Text, Sheets("contrato").Cells(lin, 61).Value
    End If
        
    If txt_T_Anexo11.Value <> "" Then
        Sheets("contrato").Cells(lin, 62).Value = ThisWorkbook.Path & "" & "ANEXO 11 - TERMO ADITIVO REFERENTE CONTRATO " & txt_TRC_Numero & txt_TRC_Ano & ".pdf"
            FileCopy txt_T_Anexo11.Text, Sheets("contrato").Cells(lin, 62).Value
    End If
        
    If txt_T_Anexo12.Value <> "" Then
        Sheets("contrato").Cells(lin, 63).Value = ThisWorkbook.Path & "" & "ANEXO 12 - TERMO ADITIVO REFERENTE CONTRATO " & txt_TRC_Numero & txt_TRC_Ano & ".pdf"
            FileCopy txt_T_Anexo12.Text, Sheets("contrato").Cells(lin, 63).Value
    End If
   
    Sheets("contrato").Cells(lin, 64).Value = Me.txt_TRC_Numero.Value & Me.txt_TRC_Ano.Value
End Sub

Esse código grava os dados nas linhas de 41 à 75, ou seja, começa em "AO" e termina em "BW".
O que eu preciso é bolar uma maneira desse código verificar condições para gravar os dados no lugar correto da minha planilha, tipo: Se a linha 41 for igual a Empty(vazio) ele grava no lugar que eu citei como exemplo, senão grava nas linhas 76 à 110, senão nas linhas 111 à 145 e assim por diante (isso repetiria 10 vezes) que é o máximo de termos aditivos que eu permito cadastrar.

Eu até imaginino a lógico do funcionamento, mas não vejo como escrever isso sem que o código fique GIGANTE.

Espero que algum amigo do fórum possa me dar uma força nesse problema. Desde já agradeço a atenção de todos e desejo Boas Festas.

 
Postado : 12/12/2013 8:16 am
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Desculpe, mas não entendi?
O descrito acima grava somente na linha determinada inicialmente pelo primeiro If.
Não é Coluna 41 até coluna 75, a que se refere? Porem no código vai "apenas" da coluna 41 até coluna 64

 
Postado : 12/12/2013 8:38 am
 bilokas
(@bilokas)
Posts: 168
Reputable Member
Topic starter
 

Obrigado por responder Reinaldo, realmente eu colei faltando uma parte:

    Sheets("contrato").Cells(lin, 65).Value = Me.DTPicker_GT_DataInicio.Value
    Sheets("contrato").Cells(lin, 66).Value = Me.DTPicker_GT_DataTermino.Value

    Sheets("contrato").Cells(lin, 67).Value = Me.txt_GT_Valor.Value
    Sheets("contrato").Cells(lin, 68).Value = Me.txt_GT_Observacao.Value
    Sheets("contrato").Cells(lin, 69).Value = Me.txt_GT_Situacao.Value

    If txt_GT_Anexo01.Value <> "" Then
        Sheets("contrato").Cells(lin, 70).Value = ThisWorkbook.Path & "" & "ANEXO 01 - GARANTIA REFERENTE TERMO ADITIVO - " & txt_GRT_Numero & txt_GRT_Ano & ".pdf"
            FileCopy txt_GT_Anexo01.Text, Sheets("contrato").Cells(lin, 70).Value
    End If
    
    If txt_GT_Anexo02.Value <> "" Then
        Sheets("contrato").Cells(lin, 71).Value = ThisWorkbook.Path & "" & "ANEXO 02 - GARANTIA REFERENTE TERMO ADITIVO - " & txt_GRT_Numero & txt_GRT_Ano & ".pdf"
            FileCopy txt_GT_Anexo02.Text, Sheets("contrato").Cells(lin, 71).Value
    End If
        
    If txt_GT_Anexo03.Value <> "" Then
        Sheets("contrato").Cells(lin, 72).Value = ThisWorkbook.Path & "" & "ANEXO 03 - GARANTIA REFERENTE TERMO ADITIVO - " & txt_GRT_Numero & txt_GRT_Ano & ".pdf"
            FileCopy txt_GT_Anexo03.Text, Sheets("contrato").Cells(lin, 72).Value
    End If
        
    If txt_GT_Anexo04.Value <> "" Then
        Sheets("contrato").Cells(lin, 73).Value = ThisWorkbook.Path & "" & "ANEXO 04 - GARANTIA REFERENTE TERMO ADITIVO - " & txt_GRT_Numero & txt_GRT_Ano & ".pdf"
            FileCopy txt_GT_Anexo04.Text, Sheets("contrato").Cells(lin, 73).Value
    End If
        
    If txt_GT_Anexo05.Value <> "" Then
        Sheets("contrato").Cells(lin, 74).Value = ThisWorkbook.Path & "" & "ANEXO 05 - GARANTIA REFERENTE TERMO ADITIVO - " & txt_GRT_Numero & txt_GRT_Ano & ".pdf"
            FileCopy txt_GT_Anexo05.Text, Sheets("contrato").Cells(lin, 74).Value
    End If
        
    Sheets("contrato").Cells(lin, 75).Value = Me.txt_GRT_Numero.Value & Me.txt_GRT_Ano.Value

    MsgBox "Cadastro realizado com sucesso.", vbInformation, "SUCESSO!"
    Unload Me
    frmCadastro.Show

Quanto a você não ter entendido é o seguinte:
Imagine que eu possa cadastrar até 10 vezes na mesma planilha esse código que eu passei, o eu preciso é de algum tipo de critério que verifique se ja foi cadastrado ou não.

As linhas onde começam essas informações são: 41, 76, 111, 146, 181, 216, 251, 286, 321 e 356.

 
Postado : 12/12/2013 8:56 am
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa tarde!!

Por ventura, não seria interessante postar seu arquivo modelo, para que o pessoa possa ajuda-lo?

Att

 
Postado : 12/12/2013 9:38 am
 bilokas
(@bilokas)
Posts: 168
Reputable Member
Topic starter
 

Conforme pediram, segue anexo.

0001Controle_de_Contratos.rar
 
Postado : 12/12/2013 10:02 am
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

bilokas,
pelo seu modelo, onde no tópico acima e mencionado "As linhas onde começam", deveria ser "As colunas onde começam", e a linha será a que se refere o contrato.

Também pelo ser modelo, não visualizei/localizei a possibilidade de cadastrar/incluir + do que um termo aditivo ou garantia...; somente o botão cadastrar, que a cada clique irá executar a rotina que postou, porem a cada clique limpa os valores dos campos no formulário,mudará de linha, inserindo o novo termo e os demais dados nessa nova linha.

O mesmo ocorre no formulário de Consulta, que possui um botão para edição (esse "libera" os campos para alteração) e o botão salvar, que "registra" os dados do formulário na linha editada.

Então não entendi (ainda, desculpe) como pretende inserir novos ou mais termos e/ou Garantia

 
Postado : 12/12/2013 11:51 am
 bilokas
(@bilokas)
Posts: 168
Reputable Member
Topic starter
 

Obrigado mais uma vez pela sua atenção. Vou tentar explicar novamente da forma mais explícita possível.

Meu projeto cadastra, 4 tipos de informação: CONTRATO, GARANTIA DO CONTRATO, TERMO ADITIVO E GARANTIA DO TERMO ADITIVO;
Cada contrato pode ter apenas 1 garantia do contrato e até 10 termos aditivos com suas respectivas garantias;

Da forma como meu projeto está, ele só grava apenas 1 termo aditivo e 1 garantia do termo aditivo para cada contrato.
O que eu preciso é de uma condição para avançar as colunas e salvar os outros termos e garantias nos seus respectivos lugares na planilha.

 
Postado : 12/12/2013 12:46 pm
 bilokas
(@bilokas)
Posts: 168
Reputable Member
Topic starter
 

Preciso muito da ajuda dos colegas, caso alguém possa me dar essa força, será de grande ajuda para meu trabalho.

 
Postado : 12/12/2013 9:30 pm
Forum Jump:
  Tópico Anterior
Próximo Tópico