Notifications
Clear all

Problemas na Worksheet_Change ou Worksheet_SelectionChange

4 Posts
2 Usuários
0 Reactions
584 Visualizações
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
Topic starter
 

Pessoal,
Preciso de ajuda. Não consigo inserir as 2 funções abaixo, na Worksheet_Change ou na Worksheet_SelectionChange, onde for mais apropriado.
Além disso, os códigos estão muitos "pesados". Aceito sugestões.

Função 1
If Plan1.Range("A4").Value = 1 Then
btnPrimeiro.Enabled = False
btnAnterior.Enabled = False
btnProximo.Enabled = True
btnUltimo.Enabled = True
ElseIf Plan1.Range("A4").Value = Plan1.Range("Y4").Value Then
btnPrimeiro.Enabled = True
btnAnterior.Enabled = True
btnProximo.Enabled = False
btnUltimo.Enabled = False
Else
btnPrimeiro.Enabled = True
btnAnterior.Enabled = True
btnProximo.Enabled = True
btnUltimo.Enabled = True
End If

Função 2
If Plan1.Range("A4").Value < 1 Or Plan1.Range("A4").Value > Plan1.Range("Y4").Value Then
AutoFechaMsgBox "O Concurso Nº " & Range("A4").Value & " da MegaSena Não Foi Encontrado! " & Chr(13) & Chr(13) & "Planilha Atualizada Até o Concurso Nº: " & Range("Y4"), "Planilha MegaSena", 2
Plan1.Range("A4").Select
End If

'----------------------------------------------------------------------------------------
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Plan1.Unprotect Password:="gerentegeral2"
Cells.Interior.ColorIndex = xlNone

With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With

If WorksheetFunction.CountA(Range("B5:P5")) = 0 Then
BtnLimpa1.Visible = False
Else
BtnLimpa1.Visible = True
End If

If WorksheetFunction.CountA(Range("B6:P6")) = 0 Then
BtnLimpa2.Visible = False
Else
BtnLimpa2.Visible = True
End If

If Not Intersect(Target, Me.[B5]) Is Nothing Then
Plan1.Range("A5").Interior.ColorIndex = 6
Plan1.Range("A5").Font.ColorIndex = 3
Else
Plan1.Range("A5").Font.ColorIndex = 1
Plan1.Range("A5").Interior.ColorIndex = xlNone
End If

If Not Intersect(Target, Me.[B6]) Is Nothing Then
Plan1.Range("A6").Interior.ColorIndex = 6
Plan1.Range("A6").Font.ColorIndex = 3
Else
Plan1.Range("A6").Font.ColorIndex = 1
Plan1.Range("A6").Interior.ColorIndex = xlNone
End If

Application.ScreenUpdating = True
Application.EnableEvents = True

Plan1.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="gerentegeral2"
Plan1.EnableSelection = xlUnlockedCells

End Sub

'-------------------------------------------------------------------------------

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Application.EnableEvents = False
Plan1.Unprotect Password:="gerentegeral2"

On Error GoTo Erro

If Target.Cells.Count > 1 Or IsEmpty(Target(1, 1)) Then Exit Sub
If Intersect(Target, Range("B5:P14")) Is Nothing Then Exit Sub
If Target.Value < 1 Or Target.Value > 60 Or Target.Cells.Count > 1 Then 'de 01 a 99.
MsgBox "Dezena Inválida!" & Chr(13) & "Somente Valores de 01 a 60.", vbInformation, "Planilha MegaSena"
Target.Offset(0, 0).Select
' Application.Undo
Target.Value = ""
End If

If WorksheetFunction.CountIf(Range(Cells(Target.Row, 2), Cells(Target.Row, 16)), Target.Value) > 1 Then
MsgBox "Dezena Inválida!" & Chr(13) & "A Dezena " & Format(Target.Value, "#00") & " Já Existe Neste Jogo.", vbInformation, "Planilha MegaSena"
Target.Offset(0, 0).Select
' Application.Undo
Target.Value = ""
End If

Application.ScreenUpdating = True
Application.EnableEvents = True

If Not Range("v17") Is Nothing Then
If Range("v17") = 1 Then
Alarme1
ActiveSheet.Label2.Visible = False
Else
ActiveSheet.Label2.Visible = False
End If
End If

Application.MoveAfterReturnDirection = xlToRight

Exit Sub 'É necessário para que, na NÃO ocorrência de erro, evitar que o tratamento de erro seja executado

Erro: 'À partir daqui inicia-se o tratamento do erro
MensagemDeErro
'MsgBox "Comando Processado!", vbInformation + vbOKOnly, "Planilha MegaSena"
End Sub

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 26/06/2016 6:34 pm
(@mprudencio)
Posts: 2749
Famed Member
 

O ideal seria disponibilizar o arquivo com alguns dados e o codigo e principalmente o objetivo do codigo.

O que ele faz ou deve fazer?

Marcelo Prudencio
Microsoft Excel Brasil no Facebook

"Começar já é a metade do caminho."
Autor Desconhecido

Simplifica que simples fica.
Nicole Tomazella.

"O Simples é Sempre Melhor Que o Complicado"
Jorge Paulo Lemann.

 
Postado : 26/06/2016 6:41 pm
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
Topic starter
 

Segue planilha em anexo.
Grato,
Pedro

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 27/06/2016 4:27 pm
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
Topic starter
 

Segue planilha em anexo.
Grato,
Pedro

Na planilha anexa, preciso manipular botões de comando (função 1) e inserir validação de dados (função 2), na Worksheet_Change ou
na Worksheet_SelectionChange.
É possível?

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 30/06/2016 5:04 pm