Vários comandos

[RTaveira 0]

Olá,

 

Vi a necessidade de muitas pessoas quanto ás funções, por isso fiz um juntão das funções que conheço e que peguei no fórum, segue elas:

 

Retirados do Fórum IMasters

 

Aplicativo Iniciando com o Windows

 

Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As LongPrivate Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As LongPrivate Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As LongPrivate Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Longpublic Const HKEY_LOCAL_MACHINE = &H80000002Private Const REG_SZ = 1Public Sub GravarValorRegistro(Chave As Long, Caminho As String, Descricao As String, Dados As String)	Dim Retorno As Variant	RegCreateKey Chave, Caminho, Retorno	RegSetValueEx Retorno, Descricao, 0, REG_SZ, ByVal Dados, Len(Dados)	RegCloseKey RetornoEnd SubPublic Sub DeletarValorRegistro(Chave As Long, Caminho As String, Descricao As String)	Dim Retorno As Variant	RegCreateKey Chave, Caminho, Retorno	RegDeleteValue Retorno, Descricao	RegCloseKey RetornoEnd SubDepois, é só chamar as rotinas, quando quiser adicionar seu programa na inicialização:GravarValorRegistro HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Run", "Nome do seu programa", "Caminho para executável do seu programa"Ou quando quiser remover da inicialização:DeletarValorRegistro HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Run", "Nome do seu programa"

Transforma tudo em maiúscula

 

If KeyAscii >= 97 And KeyAscii <= 122 ThenKeyAscii = KeyAscii - 32End If

Imprimindo um textbox

Printer.Print TextBox1.TextPrinter.EndDoc

Centralizando Objetos

 

Command1.Left = Form1.Width / 2 - Command1.Width / 2

Contador regressivo para desligar o PC

 

Shell ("shutdown -s -t 10")

Salvando o resultado .TXT

n = FreeFile() 'Obtém um número de arquivo livreOpen "c:\arquivo.txt" For Output As #n 'Abre o arquivo para saída/gravação (output) com o número #n? #, Label1.Caption 'Grava o valor no arquivoClose #n 'Fecha o arquivo

Por outros autores

 

Abrir drive de CD-ROM

 

Call mciSendString("Set CDAudio Door Open Wait", 0&, 0&, 0&)

Fechar drive de CD-ROM

 

Call mciSendString("Set CDAudio Door Closed Wait", 0&, 0&, 0&)

Abrir E-Mail

Dim Ret&		Ret = ShellExecute(Me.hWnd, "Open", "mailto:vilmar@vilmarbro.eti.br", "", App.Path, 1)

Abrir Site

 

Dim Ret&	Ret = ShellExecute(Me.hWnd, "Open", "http://www.vilmarbro.eti.br", "", App.Path, 1)

Reconhecendo Teclas

If (KeyCode = [TECLA]) then Beep'TECLA significa o valor para a tecla pressionada.'Os valores estão no HELP do VB em "Keycode Constants"'Ex.: If (KeyCode = VbKeyF2) then Beep'Toca um Beep quando a teclar F2 for apertada.

Verificador de CPF

 

Dim cgc As StringDim resto As IntegerDim resto2 As IntegerStatic val(15) As IntegerStatic val1(15) As IntegerDim total As IntegerDim total2, total3, total4 As IntegerDim totaldig1, totaldig2 As IntegerDim conta, i As Integerconta = Len(txtcgc)cmdlimpa.Visible = Truetxtcgc.Enabled = FalseIf conta = 14 ThenText1 = Mid(txtcgc, 1, 1)Text2 = Mid(txtcgc, 2, 1)Text3 = Mid(txtcgc, 3, 1)Text4 = Mid(txtcgc, 4, 1)Text5 = Mid(txtcgc, 5, 1)Text6 = Mid(txtcgc, 6, 1)Text7 = Mid(txtcgc, 7, 1)Text8 = Mid(txtcgc, 8, 1)Text9 = Mid(txtcgc, 9, 1)Text10 = Mid(txtcgc, 10, 1)Text11 = Mid(txtcgc, 11, 1)Text12 = Mid(txtcgc, 12, 1)Text13 = Mid(txtcgc, 13, 1)Text14 = Mid(txtcgc, 14, 1)val(0) = Text12 * 2val(1) = Text11 * 3val(2) = Text10 * 4val(3) = Text9 * 5val(4) = Text8 * 6val(5) = Text7 * 7val(6) = Text6 * 8val(7) = Text5 * 9val(8) = Text4 * 2val(9) = Text3 * 3val(10) = Text2 * 4val(11) = Text1 * 5total = val(0) + val(1) + val(2) + val(3) + val(4) + val(5) + val(6) + val(7) + val(8) + val(9) + val(10) + val(11)total2 = total Mod 11If total2 <= 1 Thentotaldig1 = 0Elsetotaldig1 = 11 - total2End Ifval1(0) = Text12 * 3val1(1) = Text11 * 4val1(2) = Text10 * 5val1(3) = Text9 * 6val1(4) = Text8 * 7val1(5) = Text7 * 8val1(6) = Text6 * 9val1(7) = Text5 * 2val1(8) = Text4 * 3val1(9) = Text3 * 4val1(10) = Text2 * 5val1(11) = Text1 * 6val1(12) = Text13 * 2total3 = val1(0) + val1(1) + val1(2) + val1(3) + val1(4) + val1(5) + val1(6) + val1(7) + val1(8) + val1(9) + val1(10) + val1(11) + val1(12)total4 = total3 Mod 11If total4 <= 1 Thentotaldig2 = 0Elsetotaldig2 = 11 - total4End IfIf Text13 = totaldig1 Then	If Text14 = totaldig2 Then	MsgBox "CNPJ Correto", vbOKOnly, "CNPJ"	Else	MsgBox "CNPJ Incorreto", vbOKOnly, "CNPJ"	End IfElse	MsgBox "CNPJ Incorreto", vbOKOnly, "CNPJ"End IfElse	If conta = 11 Then	Text15 = Mid(txtcgc, 1, 1)	Text16 = Mid(txtcgc, 2, 1)	Text17 = Mid(txtcgc, 3, 1)	Text18 = Mid(txtcgc, 4, 1)	Text19 = Mid(txtcgc, 5, 1)	Text20 = Mid(txtcgc, 6, 1)	Text21 = Mid(txtcgc, 7, 1)	Text22 = Mid(txtcgc, 8, 1)	Text23 = Mid(txtcgc, 9, 1)	Text24 = Mid(txtcgc, 10, 1)	Text25 = Mid(txtcgc, 11, 1)		val(0) = Text23 * 2	val(1) = Text22 * 3	val(2) = Text21 * 4	val(3) = Text20 * 5	val(4) = Text19 * 6	val(5) = Text18 * 7	val(6) = Text17 * 8	val(7) = Text16 * 9	val(8) = Text15 * 10		total = val(0) + val(1) + val(2) + val(3) + val(4) + val(5) + val(6) + val(7) + val(8)	total2 = total Mod 11		If total2 <= 1 Then			totaldig1 = 0		Else			totaldig1 = 11 - total2		End Ifval1(12) = Text24 * 2val1(0) = Text23 * 3val1(1) = Text22 * 4val1(2) = Text21 * 5val1(3) = Text20 * 6val1(4) = Text19 * 7val1(5) = Text18 * 8val1(6) = Text17 * 9val1(7) = Text16 * 10val1(8) = Text15 * 11total3 = val1(0) + val1(1) + val1(2) + val1(3) + val1(4) + val1(5) + val1(6) + val1(7) + val1(8) + val1(12)total4 = total3 Mod 11If total4 <= 1 Thentotaldig2 = 0Elsetotaldig2 = 11 - total4End IfIf Text24 = totaldig1 Then	If Text25 = totaldig2 Then	MsgBox "CPF Correto", vbOKOnly, "CPF"	Else	MsgBox "CPF Incorreto", vbOKOnly, "CPF"	End IfElse	MsgBox "CPF Incorreto", vbOKOnly, "CPF"End If	Else	MsgBox "Favor digitar o CPF/CNPJ corretamente.", vbExclamation, "Aviso"	End IfEnd If

Sabe algum comando que não tem nessa lista ?

Poste aí, você pode ajudar muitas pessoas.

[Claudio Neto 3]

Strous, meus parabéns pela iniciativa, foi legal. Tem muita coisa ai interessante. Posso somente colocar uma segunda opção para um código verificador de CPF? Segue abaixo:

Dim calcCPF As IntegerDim arrCPF(1 To 14) As StringDim verCPF As IntegerDim auxCPF As IntegerWith txtCNPJIf .Text = "" ThenElse    If Mid(.Text, 3, 1) <> "." And Mid(.Text, 15, 1) <> "" Then        MsgBox "Há números digitados a mais", vbInformation, "Alerta"        .SetFocus        .SelStart = 0        .SelLength = Len(Screen.ActiveControl.Text)    Else        If Mid(.Text, 12, 1) <> "" And Mid(.Text, 14, 1) = "" Then            MsgBox "A quantidade de dígitos não confere", vbInformation, "Alerta"            .SetFocus            .SelStart = 0            .SelLength = Len(Screen.ActiveControl.Text)            Exit Sub        Else            If Mid(.Text, 12, 1) = "" Then                            For auxCPF = 1 To 11 Step 1                    arrCPF(auxCPF) = Mid(.Text, auxCPF, 1)                    If arrCPF(auxCPF) = "" Then                        MsgBox "Faltam dígitos no CPF digitado", vbInformation, "Alerta"                        .SetFocus                        .SelStart = 0                        .SelLength = Len(Screen.ActiveControl.Text)                        Exit Sub                    End If                Next                        .Text = arrCPF(1) & arrCPF(2) & arrCPF(3) & "." & arrCPF(4) & arrCPF(5) & arrCPF(6) & "." & arrCPF(7) & arrCPF(8) & arrCPF(9) & "-" & arrCPF(10) & arrCPF(11)                        auxCPF = Len(txtCNPJ)                                    If arrCPF(10) = (((arrCPF(9) * 9 + arrCPF(8) * 8 + arrCPF(7) * 7 _                + arrCPF(6) * 6 + arrCPF(5) * 5 + arrCPF(4) * 4 + arrCPF(3) _                * 3 + arrCPF(2) * 2 + arrCPF(1) * 1) Mod 11) Mod 10) Then                                        Else                    MsgBox "Há um erro no CPF informado", vbExclamation, "Alerta"                    .SetFocus                    .SelStart = 0                    .SelLength = Len(Screen.ActiveControl.Text)                    Exit Sub                End If                            If arrCPF(11) = (((arrCPF(10) * 9 + arrCPF(9) * 8 + arrCPF(8) * 7 _                + arrCPF(7) * 6 + arrCPF(6) * 5 + arrCPF(5) * 4 + arrCPF(4) _                * 3 + arrCPF(3) * 2 + arrCPF(2) * 1) Mod 11) Mod 10) Then                                Else                    MsgBox "Há um erro no CPF informado", vbExclamation, "Alerta"                    .SetFocus                    .SelStart = 0                    .SelLength = Len(Screen.ActiveControl.Text)                    Exit Sub                End If            Else                If (Mid(.Text, 4, 1) = "." And Mid(.Text, 12, 1) = "-") Then                                        For auxCPF = 1 To 14 Step 1                        arrCPF(auxCPF) = Mid(.Text, auxCPF, 1)                    Next                                        If arrCPF(13) = (((arrCPF(11) * 9 + arrCPF(10) * 8 + arrCPF(9) * 7 _                    + arrCPF(7) * 6 + arrCPF(6) * 5 + arrCPF(5) * 4 + arrCPF(3) _                    * 3 + arrCPF(2) * 2 + arrCPF(1) * 1) Mod 11) Mod 10) Then                                        Else                        If (((arrCPF(11) * 9 + arrCPF(10) * 8 + arrCPF(9) * 7 _                        + arrCPF(7) * 6 + arrCPF(6) * 5 + arrCPF(5) * 4 + arrCPF(3) _                        * 3 + arrCPF(2) * 2 + arrCPF(1) * 1) Mod 11) Mod 10) = 10 And arrCPF(10) = 0 Then                                                Else                            MsgBox "Há um erro no CPF informado", vbExclamation, "Alerta"                            .SetFocus                            .SelStart = 0                            .SelLength = Len(Screen.ActiveControl.Text)                            Exit Sub                        End If                    End If                                If arrCPF(14) = ((arrCPF(13) * 9 + arrCPF(11) * 8 + arrCPF(10) * 7 _                    + arrCPF(9) * 6 + arrCPF(7) * 5 + arrCPF(6) * 4 + arrCPF(5) _                    * 3 + arrCPF(3) * 2 + arrCPF(2) * 1) Mod 11) Then                                        Else                        MsgBox "Há um erro no CPF informado", vbExclamation, "Alerta"                        .SetFocus                        .SelStart = 0                        .SelLength = Len(Screen.ActiveControl.Text)                        Exit Sub                    End If                Else                    If (Mid(.Text, 3, 1) = "." And Mid(.Text, 11, 1) = "/") Then                        Else                        If Mid(.Text, 14, 1) <> "" Then                                                        For auxCPF = 1 To 14 Step 1                                arrCPF(auxCPF) = Mid(txtCNPJ, auxCPF, 1)                            Next                                                        .Text = arrCPF(1) + arrCPF(2) + "." + arrCPF(3) + arrCPF(4) + arrCPF(5) + "." + arrCPF(6) _                            + arrCPF(7) + arrCPF(8) + "/" + arrCPF(9) + arrCPF(10) + arrCPF(11) + arrCPF(12) + "-" + arrCPF(13) + arrCPF(14)                        End If                    End If                End If            End If        End If    End IfEnd If

Gosto do código acima porque está bem completo.Cancelei a utilização de teclas que não sejam números, vai até mais uma função:

    If KeyAscii <> 8 And (KeyAscii < 48 Or KeyAscii > 57) Then        KeyAscii = 0    End If

Bloqueei as outras teclas só permitindo números para que somente fosse preenchido de uma maneira, visto que se a pessoa já preenche com os pontos, daria erro na hora de rodar a fórmula.A função serve tanto para CPF quanto para CNPJ, isso era uma necessidade em meu programa, então ele conta quantos digitos têm, e pela quantidade já sabe se é um CPF ou CNPJ.Reparem que se forem digitados a quantidade errada de números ele também já avisa.Bom, acho que é isso, caso alguém tenha alguma dúvida sobre, só perguntar.Abraços.

[RTaveira 0]

Boa Claudio, valeu pela contribuição !