Leonardo,
Tenho comentários no seu código. Não tenho como resolver o problema original que você solicitou ainda porque tem coisas muito mais importantes que você precisa consertar antes em seu projeto. Podemos fazer muitas melhorias nele.
---
Em Private Sub Workbook_Open(), Substituí o código:
Sheets(">> MENU >> DESVIOS").Select
por
On Error Resume Next
Sheets(">> MENU >> DESVIOS").Select
Sheets(">> MENU >> DESVIOS").Activate
On Error GoTo 0
Muitas vezes, quando se abre uma Pasta de Trabalho por e-mail ou através de um download, o método Select ou Activate retorna um erro. Para suprimir a interrupção da rotina, fiz esse pequeno tratamento de exceção. Leia mais sobre tratamento de exceção em:
http://www.ambienteoffice.com.br/officevba/tratamento_de_excecao/.
---
Notei que você usa exaustivamente a rotina:
With ActiveWindow
Application.DisplayFullScreen = True
ActiveWindow.DisplayHeadings = False
Application.DisplayFormulaBar = False
ActiveWindow.DisplayHorizontalScrollBar = True
ActiveWindow.DisplayVerticalScrollBar = True
ActiveWindow.DisplayWorkbookTabs = False
Application.DisplayStatusBar = False
End With
E usa também, a rotina contrária, para voltar a exibição da Pasta de Trabalho para o normal. Você pode economizar muitas linhas de código criando dois procedimentos chamados, por exemplo,
TelaCheia e TelaNormal:
Sub TelaCheia()
With ActiveWindow
Application.DisplayFullScreen = True
ActiveWindow.DisplayHeadings = False
Application.DisplayFormulaBar = False
ActiveWindow.DisplayWorkbookTabs = False
Application.DisplayStatusBar = False
End With
End Sub
Sub TelaNormal()
With ActiveWindow
Application.DisplayFullScreen = False
ActiveWindow.DisplayHeadings = True
Application.DisplayFormulaBar = True
ActiveWindow.DisplayWorkbookTabs = True
Application.DisplayStatusBar = True
End With
End Sub
E então, fazer chamada a eles quando precisar:
Sub Exemplo()
TelaCheia
'...
'Código aqui. Chamada de formulários e outras rotinas
'...
TelaNormal
End Sub
Isso ajuda a manter seu código organizado. Além disso, se você quiser alterar essa etapa do código, você irá fazê-la em apenas um lugar ao invés de fazer em trechos de código. Fiz essas alterações.
(acabei de ver que você já tinha duas rotinas aqui, chamadas OcultarContornos e ReexibirContornos, mas você não as usou em seu código)
---
Você não está usando a opção Option Explicit! Esse é o erro mais grave de qualquer projeto em VBA. Leia mais em:
http://www.ambienteoffice.com.br/officevba/declaracao_de_variavel/.
---
Percebi que você não estava usando o método Unload Me para fechar alguns formulários, ao sair. Não esqueça de utilizá-lo! Inseri os métodos nos lugares que estavam faltando.
---
Em UFSENHAENTRADA, o código:
Private Sub UserForm_QueryClose(Cancel As Integer, FECHAR As Integer)
If FECHAR = vbFormControlMenu = True Then
Cancel = True
End If
End Sub
Por que usá-lo? Impedir um usuário de fechar uma janela quando quiser é irritante. Sugiro remoção do código.
Eu entendo que você deve processar algumas informações antes de fechar o formulário. Nesse caso, use o código:
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Sair
End Sub
Private Sub CommandButton1_Click()
'Este é o botão CANCELAR
Unload Me
End Sub
Private Sub Sair()
'Workbooks("SOLICITAÇÃO DE DESVIOS.xls").Close SaveChanges:=True
Unload Me
TelaNormal
End Sub
Explicação: quando você usar o método Unload Me, a rotina UserForm_QueryClose é chamada.
---
---
Em UFSENHAENTRADA, alterei o valor da propriedade Style de
0 - fmStyleDropDownCombo para 2 - fmStyleDropDownList da Caixa de Seleção (ComboBox) cmbUsuário.
Isso significa que apenas valores constantes na caixa de seleção podem ser selecionados e não é possível digitar nenhum texto diferente de elementos constantes nele.
---
Troquei o código
Private Function RowOf(vProcura As Variant, Optional rng As Range) As Long
If TypeName(vProcura) = "Range" And rng Is Nothing Then
Set rng = vProcura.EntireColumn
End If
With rng
Set rng = .Find(vProcura, .Cells(1), xlValues, xlWhole, xlRows, xlNext, True)
If Not rng Is Nothing Then
RowOf = rng.Row
Else
RowOf = 0
End If
End With
End Function
por:
Function EleOf(va As Variant, rng As Range) As Long
'Retorna o valor da linha ou coluna de um elemento num vetor. Caso não seja encontrado, é retornado 0.
On Error Resume Next
EleOf = WorksheetFunction.Match(va, rng, 0)
End Function
Ele é mais simples, rápido e versátil, para você usar futuramente em seus próximos projetos.
---
No código:
MsgBox "NÃO DEIXE CAMPOS EM BRANCO. PREENCHA TODOS OS CAMPOS CORRETAMENTE", , "ATENÇÃO"
Alterei por:
MsgBox "NÃO DEIXE CAMPOS EM BRANCO. PREENCHA TODOS OS CAMPOS CORRETAMENTE", vbCritical, c_sPrograma
Usei vbCritical para dar um efeito estética na caixa de mensagem e constante
c_sPrograma como título. Crie um módulo chamado mdlPúblicos, que possui a definição:
Public Const c_sPrograma As String = "Sistema Solicitação de Desvios"
Você deve usar essa mesma construção de caixa de mensagem de erros em seu código. Dessa forma, todos os títulos de erros das caixas de mensagem serão padronizados e, se você quiser alterar o nome do título de todas, basta alterar o valor dessa constante.
---
Não acho necessário você usar a instrução:
Application.ScreenUpdating = False
em seu projeto, neste caso. Pus as linhas em que elas aparecem de uma forma comentada, para elas não rodarem.
---
O bloco de código:
If Me.CmbUsuario = "" Then
MsgBox "NÃO DEIXE CAMPOS EM BRANCO. PREENCHA TODOS OS CAMPOS CORRETAMENTE", vbCritical, "ATENÇÃO"
CmbUsuario.SetFocus
Else
'...código...
substituí por:
If Me.CmbUsuario = "" Then
MsgBox "NÃO DEIXE CAMPOS EM BRANCO. PREENCHA TODOS OS CAMPOS CORRETAMENTE", vbCritical, "ATENÇÃO"
CmbUsuario.SetFocus
Exit Sub
End If
Dessa forma, aninha-se menos o código e previne-se de colocar o End If, após o Else mostrado acima, num lugar errado que continue a execução de código indesejado, como vi
UFSENHAENTRADA.
---
Sobre a linha:
Application.EnableCancelKey = xlDisabled
Ela deve ser usada somente em condições muito restritas! Remova ela imediatamente do código.
Se quiser saber como fazer um bom uso dela, veja:
http://www.ambienteoffice.com.br/officevba/gerenciar_uso_de_ctrl_break_durante_execucao_de_codigo/.
---
Pessoalmente, não gosto de colocar nomes de controles ou variáveis em letras maiúsculas. Por exemplo, os nomes TXTNOMEENTRADAe TXTDATAENTRADA eu substituiria por txtNomeEntrada e txtDataEntrada.
Além disso, os nomes de Planilha CONTROLE ACESSO e FINALIZAÇÃO DESVIO por, respectivamente, Controle Acesso e Finalização Desvio.
A mesma coisa de formulários: UFSENHAENTRADA e UFSENHAENG por frmSenhaEntrada e frmSenhaEng.
---
Notei que para gravar numa Planilha, você:
1 - Torna a Planilha visível
2 - Desprotege a Planilha
3 - Seleciona a Planilha
3 - Grava informações da Planilha usando propriedades como ActiveCell
4 - Protege a Planilha
5 - Oculta a Planilha
Isso pode ser simplificado. Não é necessário que uma Planilha esteja visível nem que esteja selecionada para que você leia ou grave dados nela. Obviamente, ela deve estar desprotegida. Então essas etapas podem ser reduzidas para:
1 - Desproteger a Planilha
2 - Gravar informações da Planilha usando propriedades como Cell e Range
3 - Proteger a Planilha.
Se o objetivo for ler informações de uma Planilha oculta e protegida, você precisará apenas de uma etapa!
1 - Ler informações da Planilha usando propriedades como Cell e Range
Sim, não é necessário reexibir nem desproteger uma Planilha para ler informações dela diretamente.
Por exemplo, o formulário UFSENHAENTRADA, antes com o código:
'LANÇA OS DADOS NA PLANILHA DE CONTROLE
'REEXIBIR PLANILHA
Sheets("CONTROLE ACESSO").Visible = True
'DESPROTEGE PLANILHA
Sheets("CONTROLE ACESSO").Unprotect "123"
Sheets("CONTROLE ACESSO").Select
Sheets("CONTROLE ACESSO").Select
Range("A60000").End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveCell = Me.CmbUsuario
ActiveCell.Offset(0, 1) = Me.TXTNOMEENTRADA
ActiveCell.Offset(0, 2) = Me.TXTDATAENTRADA
'PROTEGE PLANILHA
ActiveWorkbook.Unprotect "123"
Sheets("CONTROLE ACESSO").Protect "123", True, True, True
'OCULTA PLANILHA
Sheets("CONTROLE ACESSO").Select
ActiveWindow.SelectedSheets.Visible = False
TelaCheia
'REEXIBIR PLANILHA
Sheets("Dados").Visible = True
'DESPROTEGE PLANILHA
Sheets("Dados").Unprotect "123"
Sheets("Dados").Select
'Application.ScreenUpdating = False
'Application.EnableCancelKey = xlDisabled
Dim Nome
Dim Linha
Nome = CmbUsuario
Linha = Me.CmbUsuario.ListIndex
ActiveWorkbook.Unprotect "123"
Sheets("Dados").Visible = True
Sheets("Dados").Select
Range("A2").Offset(Linha, 2).Select
ActiveCell = TxtSenha.Value
If ActiveCell <> ActiveCell.Offset(0, -1) Then
MsgBox "Senha Inválida", , "Aviso"
Me.TxtSenha.Value = ""
Me.TxtSenha.SetFocus
Exit Sub
Else
Sheets("Dados").Visible = True
ActiveWorkbook.Protect "123"
Sheets("dados").Select
'PROTEGE PLANILHA
ActiveWorkbook.Unprotect "123"
Sheets("Dados").Protect "123", True, True, True
'OCULTA PLANILHA
Sheets("Dados").Select
ActiveWindow.SelectedSheets.Visible = False
End If
Sheets(">> MENU >> DESVIOS").Select
Fica com o código bem mais enxuto:
Private Sub btnOK_Click()
Dim lRow As Long
If cmbDepartamento = "" Then
MsgBox "Selecione um Departamento!", vbCritical, c_sPrograma
cmbDepartamento.SetFocus
Exit Sub
End If
With Sheets("Dados")
lRow = EleOf(cmbDepartamento, .Columns("A"))
If txtSenha <> .Cells(lRow, "B") Then
MsgBox "Senha incorreta!", vbCritical, c_sPrograma
Exit Sub
End If
End With
'Lança os dados na Planilha CONTROLE ACESSO:
With Sheets("CONTROLE ACESSO")
.Unprotect "123"
lRow = RowLast(.Columns("A")) + 1
.Cells(lRow, "A") = cmbDepartamento
.Cells(lRow, "B") = txtNomeEntrada
.Cells(lRow, "C") = txtDataEntrada
.Protect "123"
End With
Unload Me
End Sub
Sugiro que você estude e entenda muito bem o código acima.
Note que criei uma função chamada RowLast, que retorna a última linha populada de uma coluna. Ela se num módulo chamado
mdlComuns junto com a função EleOf, citada acima.
Veja como está o arquivo modificado: https://skydrive.live.com/redir?resid=FB206A2D510E0661!373.
Felipe Costa Gualberto - http://www.ambienteoffice.com.br
