Este fórum foi descontinuado. LEIA AQUI e participe da Comunidade BABOO :)

Ir para conteúdo
Oscar

Diferentes planilha preenchidas com um único formulário.

Mensagem Recomendada

Olá!

Tenho um formulário para cadastro entrada de notas fiscais de 10 Empresas.

Gostaria que este formulário salvasse os dados em diferentes planilhas segundo a empresa.

Quando eu entrasse com o nome "Empresa 1" ele salvaria os dados na planilha "Empresa1".

Quando eu entrasse com o nome "Empresa 2" ele salvaria os dados na planilha "Empresa 2".

No formulário tenho uma caixa de combinação para selecionar a empresa

Atualmente ele salva todos os dados na mesma planilha então tenho que a partir desta planilha redirecionar os dados manualmente.

No formulário indico:

Nome da Empresa (caixa com seleção);

Nº da nota;

Data Emissão;

Valor;

Ordem de Pagamento.

Abaixo o código:

Private Sub CommandButton1_Click()
    lsInserirTextBox frmCadastro, "Cadastro", 1
    
    lsLimparTextBox frmCadastro
    
    TextBox1.SetFocus
End Sub

Private Sub lsInserir(ByRef lTextBox As Variant, ByVal lSheet As String, ByVal lColunaCodigo As Long, ByVal lUltimaLinha As Long)
    If (TypeOf lTextBox Is MSForms.TextBox) Or (TypeOf lTextBox Is MSForms.ComboBox) Then
        Sheets(lSheet).Range(lTextBox.Tag & lUltimaLinha).Value = lTextBox.Text
    Else
        If TypeOf lTextBox Is MSForms.OptionButton Then
            If lTextBox.Value = True Then
                Sheets(lSheet).Range(lTextBox.Tag & lUltimaLinha).Value = lTextBox.Caption
            End If
        End If
    End If
End Sub

Public Function lsInserirTextBox(formulario As UserForm, ByVal lSheet As String, ByVal lColunaCodigo As Long)
    Dim controle            As Control
    Dim lUltimaLinhaAtiva   As Long
    
    lUltimaLinhaAtiva = Worksheets(lSheet).Cells(Worksheets(lSheet).Rows.Count, lColunaCodigo).End(xlUp).Row + 1
    
    For Each controle In formulario.Controls
        lsInserir controle, lSheet, lColunaCodigo, lUltimaLinhaAtiva
    Next
End Function

Public Function lsLimparTextBox(formulario As UserForm)
    Dim controle            As Control
    
    For Each controle In formulario.Controls
        If TypeOf controle Is MSForms.TextBox Then
            controle.Text = ""
        End If
    Next
End Function

Private Sub CommandButton2_Click()
    lsLimparTextBox frmCadastro
    
    TextBox1.SetFocus
End Sub

Private Sub UserForm_Click()

End Sub

 

Desde já agradeço pela ajuda.

 

Compartilhar este post


Link para o post
Compartilhar em outros sites

×
×
  • Criar Novo...