locked
Forms RRS feed

  • Pergunta

  • Boa tarde a todos,

     

    Estou precisando de uma ajuda que não consigo em lugar algum, por isso vim recorrer a este fórum bem completo e com gente bastante altruísta!

    • Editado F.meyer sexta-feira, 25 de março de 2011 17:45
    quinta-feira, 3 de março de 2011 17:54

Respostas

  • Meyer boa noite!

    Segue abaixo o código modificado de acordo com a sua necessidade, espero ter ajudado!

    João

     

     

     

     

    Option Explicit

     

    Const colCodigoDoFornecedor As Integer = 1

    Const colFuncionario As Integer = 2

    Const colEstoque As Integer = 3

    Const colServiçoPrestado As Integer = 4

    Const colDatadoRegistro As Integer = 5

    Const indiceMinimo As Byte = 2

    Const corDisabledTextBox As Long = -2147483633

    Const corEnabledTextBox As Long = -2147483643

    Const nomePlanilhaCadastro As String = "Fornecedores"

     

    Private wsCadastro As Worksheet

    Private wbCadastro As Workbook

    Private indiceRegistro As Long

     

    Private Sub btnLimpar_Click()

     

        Me.CboFuncionario = ""

        Me.txtEstoque = ""

        Me.ListBox1 = ""

     

    End Sub

     

    Private Sub btnOK_Click()

        Dim proximoId As Long

     

            proximoId = PegaProximoId

            'pega a próxima linha

            Dim proximoIndice As Long

            'atualiza o arquivo para pegar o próximo registro atualizado

            Call AtualizarArquivo(False)

            proximoIndice = wsCadastro.UsedRange.Rows.Count + 1

            Call SalvaRegistro(proximoId, proximoIndice)

     

            MsgBox "Registro salvo com sucesso"

     

        Call LimpaControles

        Call HabilitaControles

     

        CboFuncionario.SetFocus

     

    End Sub

     

    Private Sub optNovo_Click()

        Call LimpaControles

        Call HabilitaControles

        'dá o foco ao primeiro controle de dados

        CboFuncionario.SetFocus

    End Sub

     

    Private Sub CboFuncionario_Click()

     

       Select Case CboFuncionario

     

            Case "Adriana"

                Me.txtEstoque = "Estoque 4"

     

            Case "Carlos"

                Me.txtEstoque = "Estoque 3"

     

            Case "Hélio"

                Me.txtEstoque = "Estoque 5"

     

            Case "Marcelo"

                Me.txtEstoque = "Estoque 2"

     

            Case "Roberto"

                Me.txtEstoque = "Estoque 1"

     

        End Select

     

    End Sub

     

    Private Sub UserForm_Initialize()

     

        Call DefinePlanilhaDados

        Call LimpaControles

        Call HabilitaControles

         'dá o foco ao primeiro controle de dados

        CboFuncionario.SetFocus

     

        With CboFuncionario

            .AddItem "Adriana"

            .AddItem "Carlos"

            .AddItem "Hélio"

            .AddItem "Marcelo"

            .AddItem "Roberto"

        End With

     

        With ListBox1

            .AddItem "A"

            .AddItem "B"

            .AddItem "C"

            .AddItem "D"

            .AddItem "E"

            .AddItem "F"

            .AddItem "G"

            .AddItem "H"

            .AddItem "I"

            .AddItem "J"

            .AddItem "K"

            .AddItem "L"

            .AddItem "M"

            .AddItem "N"

            .AddItem "O"

            .AddItem "P"

            .AddItem "Q"

            .AddItem "R"

            .AddItem "S"

            .AddItem "T"

            .AddItem "U"

            .AddItem "V"

            .AddItem "W"

            .AddItem "X"

            .AddItem "Y"

            .AddItem "Z"

        End With

     

    End Sub

     

    Private Sub CarregaRegistro()

    'carrega os dados do primeiro registro

        With wsCadastro

            If Not IsEmpty(.Cells(indiceRegistro, colCodigoDoFornecedor)) Then

     

                Me.CboFuncionario.Value = .Cells(indiceRegistro, colFuncionario).Value

                Me.txtEstoque.Text = .Cells(indiceRegistro, colEstoque).Value

                Me.ListBox1.Value = .Cells(indiceRegistro, colServiçoPrestado).Value

     

            End If

        End With

     

        Call AtualizaRegistroCorrente

    End Sub

     

    Public Sub CarregaRegistroPorIndice(ByVal indice As Long)

    'carrega os dados do registro baseado no índice

        indiceRegistro = indice

     

        Call CarregaRegistro

    End Sub

     

    Private Sub AtualizarArquivo(ByVal ReadOnly As Boolean)

        Dim caminhoCompleto As String

        'fecha o arquivo de dados e tenta abrí-lo

        'guarda o caminho

        caminhoCompleto = wbCadastro.FullName

        wbCadastro.Saved = True

        wbCadastro.Close SaveChanges:=False

     

        'abre o arquivo em modo escrita

        Set wbCadastro = Workbooks.Open(Filename:=caminhoCompleto, ReadOnly:=False)

     

        'oculta a janela

        wbCadastro.Windows(1).Visible = True

     

        'reatribui a planilha de cadastro

        Set wsCadastro = wbCadastro.Worksheets(nomePlanilhaCadastro)

    End Sub

     

    Private Sub SalvaRegistro(ByVal id As Long, ByVal indice As Long)

        'tenta abrir o arquivo em modo escrita

        Call AtualizarArquivo(False)

     

        With wsCadastro

            .Cells(indice, colCodigoDoFornecedor).Value = id

            .Cells(indice, colFuncionario).Value = Me.CboFuncionario.Value

            .Cells(indice, colEstoque).Value = Me.txtEstoque.Text

            .Cells(indice, colServiçoPrestado).Value = Me.ListBox1.Value

            .Cells(indice, colDatadoRegistro).Value = Now()

        End With

     

        'salva o arquivo

        Call wbCadastro.Save

     

        'abre o arquivo novamente em modo leitura

        Call AtualizarArquivo(True)

     

        Call AtualizaRegistroCorrente

    End Sub

     

    Private Function PegaProximoId() As Long

        Dim rangeIds As Range

        'pega o range que se refere a toda a coluna do código (id)

        Set rangeIds = wsCadastro.Range(wsCadastro.Cells(indiceMinimo, colCodigoDoFornecedor), wsCadastro.Cells(wsCadastro.UsedRange.Rows.Count, colCodigoDoFornecedor))

        PegaProximoId = WorksheetFunction.Max(rangeIds) + 1

    End Function

     

    Private Sub AtualizaRegistroCorrente()

        lblNavigator.Caption = indiceRegistro - 1 & " de " & wsCadastro.UsedRange.Rows.Count - 1

    End Sub

     

    Private Sub LimpaControles()

     

        Me.CboFuncionario.Value = ""

        Me.txtEstoque.Text = ""

     

    End Sub

     

    Private Sub HabilitaControles()

    'Me.txtCodigoFornecedor.Locked = False

        Me.CboFuncionario.Locked = False

        Me.txtEstoque.Locked = False

        Me.ListBox1.Locked = False

     

        Me.CboFuncionario.BackColor = corEnabledTextBox

        Me.txtEstoque.BackColor = corEnabledTextBox

     

    End Sub

     

     

    Private Sub DefinePlanilhaDados()

        Dim abrirArquivo As Boolean

        Dim wb As Workbook

        Dim caminhoCompleto As String

        Dim ARQUIVO_DADOS As String

        Dim PASTA_DADOS As String

     

        abrirArquivo = True

     

        ARQUIVO_DADOS = Range("ARQUIVO_DADOS").Value

        PASTA_DADOS = Range("PASTA_DADOS").Value

     

        If ThisWorkbook.Name <> ARQUIVO_DADOS Then

            'monta a string do caminho completo

            If PASTA_DADOS = vbNullString Or PASTA_DADOS = "" Then

                caminhoCompleto = Replace(ThisWorkbook.FullName, ThisWorkbook.Name, vbNullString) & ARQUIVO_DADOS

            Else

                If Right(PASTA_DADOS, 1) = "\" Then

                    caminhoCompleto = PASTA_DADOS & ARQUIVO_DADOS

                Else

                    caminhoCompleto = PASTA_DADOS & "\" & ARQUIVO_DADOS

                End If

            End If

     

            'verifica se o arquivo não está aberto

            For Each wb In Application.Workbooks

                If wb.Name = ARQUIVO_DADOS Then

                    abrirArquivo = False

                    Exit For

                End If

            Next

     

            'atribui o arquivo

            If abrirArquivo Then

                Set wbCadastro = Workbooks.Open(Filename:=caminhoCompleto, ReadOnly:=True)

            Else

                Set wbCadastro = Workbooks(ARQUIVO_DADOS)

            End If

        Else

            Set wbCadastro = ThisWorkbook

        End If

     

        Set wsCadastro = wbCadastro.Worksheets(nomePlanilhaCadastro)

     

        'oculta o arquivo de dados

        'wbCadastro.Windows(1).Visible = False

     

    End Sub

     

    Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

        'fecha a planilha de dados, se estiver aberta

        If Not wbCadastro Is Nothing Then

            wbCadastro.Saved = True

            wbCadastro.Close SaveChanges:=False

        End If

     

        Set wbCadastro = Nothing

    End Sub


     

    • Sugerido como Resposta Joao_Claro domingo, 6 de março de 2011 04:44
    • Marcado como Resposta F.meyer quarta-feira, 16 de março de 2011 13:22
    domingo, 6 de março de 2011 04:27