Usuário com melhor resposta
Forms

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