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