Tocantinópolis-To.
Administração com enfase em Sistema da Informação.
Faculdade Nossa Senhora Aparecida de Goiânia.
Sandra Barros - Maquiadora.Pagina
João Caetano, Pedro Felipe e César Junio.
Jose Ferreira Barros e Zelene Pereira Barros.
Aparecida de Goiânia - Go.
Mini Curriculo
Profissional pro ativo com meta e objetivos, com um vasto conhecimento
na área administrativa, logistica, comercial tendo como diferencial grande
experencia em desenvolvimentos de planilhas eletronicas usando VBA e
PHP, pacote office avançado e os Sistemas Operacionais Windows, Linux.
Private Sub Workbook_Open()
'Tela de Boa Vindas e instrução de uso
MsgBox Chr(13) & "Bem Vindo ao ADV&C(Antigo V3), Para melhor conexão ao BD" & Chr(13) & _
Chr(13) & Chr(9) & "Pressione : ( CTRL + ALT + F5 )"
Sheets("Menu").Select
ActiveSheet.Unprotect
Range("H23").FormulaR1C1 = "By César Barros"
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub
Salva e Sair da Plan
Sub Salva_Sai()
' Salva_Sair Macro
' Grava e Sair da Pasta de Trabalho
MsgBox "O aplicativo será salvo e fechado!!!" & Chr(13) & _
Chr(13) & Chr(9) & "César Barros"
ActiveWorkbook.Save
Application.Quit
End Sub
Trava a planilha na execurção de uma ação
Sub travamento()
ActiveSheet.Unprotect
'msg de aguarde um momento...
Application.Cursor = xlWait
Application.ScreenUpdating = False
'ação 'Tirar a mensagem aguarde um momento.
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False
ActiveWorkbook.Save
Application.Cursor = xlDefault
Application.ScreenUpdating = True
MsgBox "Atualização Realizada com Sucesso!!!"
Sheets("Menu").Select
End Sub
Descobrir quebra senha na plan
Sub Qual_senha()
Dim i As Integer, j As Integer, k As Integer
Dim l As Integer, m As Integer, n As Integer
Dim i1 As Integer, i2 As Integer, i3 As Integer
Dim i4 As Integer, i5 As Integer, i6 As Integer
On Error Resume Next
For i = 65 To 66: For j = 65 To 66: For k = 65 To 66
For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66
For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66
For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126
ActiveSheet.Unprotect Chr(i) & Chr(j) & Chr(k) & _
Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _
Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
If ActiveSheet.ProtectContents = False Then
MsgBox "Senha: " & Chr(i) & Chr(j) & _
Chr(k) & Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _
Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
ActiveWorkbook.Sheets(1).Select
Range("a1").FormulaR1C1 = Chr(i) & Chr(j) & _
Chr(k) & Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _
Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
Exit Sub
End If
Next: Next: Next: Next: Next: Next
Next: Next: Next: Next: Next: Next
End Sub
NAO DEIXA FECHAR O FORMULARIO NO X
Private Sub UserForm_QueryClose _
(Cancel As Integer, CloseMode As Integer)
if CloseMode = vbFormControlMenu Then
MsgBox "Só Fecha na Tecla Sair!!!", vbCritical, "AVISO"
Cancel = True
End If
End Sub
Senha de Acesso com 3 tentativas
Private Sub Workbook_Open()
'Criação de Variáveis
'cont é a variável que contará a quantidade de tentativas
Dim cont As Integer
'quant é a quantidade
Dim quant As Integer
'variável para senha
Dim senha As String
'quantas vezes poderá tentar
quant = 3
'cont contará apartir de zero
cont = 0
'volta para tentar mais uma vez
volta: 'Permite que o usuário digite a senha
senha = InputBox("Digite a senha")
'Caso a senha esteja certa uma mensagem será apresentada
If senha = "ICD" Then
MsgBox "S e j a B e m V i n d o!!!" & Chr(13) & Chr(10) & Chr(13) & " I C D - S C H I N", , "Bom Dia!!!"
'Senão
Else
cont = cont + 1
'se o numero de tentativas alcançar a quantidade permitida
If cont >= quant Then
'o arquivo será fechado sem salvar
ActiveWorkbook.Close SaveChanges:=False
End
'senão mostra a mensagem de quantidadades de tentaivas
Else
MsgBox "Você Tem " & (quant - cont) & " Tentativa(s)", , "São 3 Tentativas"
'se estiver errado pode tentar mais uma vez
GoTo volta
End If
End If
End Sub
Macro pedia senha de acesso
Sub Correcao()
'
' Correcao Macro
'
Dim SELECAO
SELECAO = InputBox("Senha de Acesso")
If SELECAO = "SELECAO" Then
Sheets("Correção").Visible = True
Sheets("Correção").Select
Else: MsgBox ("Senha Errada!!!")
Exit Sub
End If
End Sub
Copia somente conteudo de uma plan para outra
Sub CopiaSomenteConteudo()
Dim NewSheet As Worksheet, CurrentSheet As Worksheet
'pega a planilha atual
Set CurrentSheet = ActiveSheet
'cria uma nova planilha
Set NewSheet = ThisWorkbook.Worksheets.Add
NewSheet.Name = CurrentSheet.Name & "2"
'copia todas as células da planilha ativa
CurrentSheet.Cells.Copy
'cola só os valores na nova planilha
NewSheet.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'zera os objetos
Set NewSheet = Nothing
Set CurrenSheet = Nothing
End Sub
