none
como faço pela vba RRS feed

  • Pergunta

    • COMO  FAZER MASCARA NA SENHA assim  como "******"  no excel

     olha o que eu fiz 

    Dim resp As String

    resp = InputBox("Digite a senha", "GpcSystem")

    If resp = "gilliardpc" Then

    If resp = "" Then Exit Sub

        Cells.Select

        Selection.EntireRow.Hidden = False

    Sheets("MATERIAS EXECUTADOS ").Select

    Else

    MsgBox "Você não tem autorização "

    fim:

    MsgBox "Não Insista"

     

    Exit Sub

    End If

    End Sub

    •   E COM O  VER Q QNTS DO VALOR DE UMA CLELULA NA PLANILHA DIFERENTE

    tenho os dados na plan2 e dodos q quantidode esta na plan3 como  eu  faço pra ver na plan2?

    eu fiz assim

    MSGBOX [A]

    • E COMO COLOCA A DATA NO TEXTBOX QUANDO EXECUTAR O SERVIIÇO DIA A DIA SEM PRESCISAR DE COLOCAR A DATA , O CAMPO JÁ FAZ ISSO

    • Editado vba access quarta-feira, 28 de agosto de 2013 15:59
    quarta-feira, 28 de agosto de 2013 15:55

Respostas

  • Olá ,

    Adicione o código abaixo a um módulo:

    'API functions to be used
    Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, _
                                                          ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
     
    Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" ( _
                                             ByVal lpModuleName As String) As Long
     
    Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" ( _
                                              ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) _
                                              As Long
     
    Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
     
    Private Declare Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" ( _
                                                ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, ByVal wParam As Long, _
                                                ByVal lParam As Long) As Long
     
    Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, _
                                                                              ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
     
    Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
     
    'Constants to be used in our API functions
    Private Const EM_SETPASSWORDCHAR = &HCC
    Private Const WH_CBT = 5
    Private Const HCBT_ACTIVATE = 5
    Private Const HC_ACTION = 0
     
    Private hHook As Long
     
    Public Function NewProc(ByVal lngCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
     
        Dim RetVal
        Dim strClassName As String, lngBuffer As Long
     
        If lngCode < HC_ACTION Then
            NewProc = CallNextHookEx(hHook, lngCode, wParam, lParam)
            Exit Function
        End If
     
        strClassName = String$(256, " ")
        lngBuffer = 255
     
        If lngCode = HCBT_ACTIVATE Then    'A window has been activated
            RetVal = GetClassName(wParam, strClassName, lngBuffer)
            If Left$(strClassName, RetVal) = "#32770" Then    'Class name of the Inputbox
                'This changes the edit control so that it display the password character *.
                'You can change the Asc("*") as you please.
                SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*"), &H0
            End If
        End If
     
        'This line will ensure that any other hooks that may be in place are
        'called correctly.
        CallNextHookEx hHook, lngCode, wParam, lParam
     
    End Function
     
    '// Make it public = avail to ALL Modules
    '// Lets simulate the VBA Input Function
    Public Function InputBoxDK(Prompt As String, Optional Title As String, Optional Default As String, _
                               Optional Xpos As Long, Optional Ypos As Long, Optional Helpfile As String, _
                               Optional Context As Long) As String
     
        Dim lngModHwnd As Long, lngThreadID As Long
     
        '// Lets handle any Errors JIC! due to HookProc> App hang!
        On Error GoTo ExitProperly
        lngThreadID = GetCurrentThreadId
        lngModHwnd = GetModuleHandle(vbNullString)
     
        hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID)
        If Xpos Then
            InputBoxDK = InputBox(Prompt, Title, Default, Xpos, Ypos, Helpfile, Context)
        Else
            InputBoxDK = InputBox(Prompt, Title, Default, , , Helpfile, Context)
        End If
     
    ExitProperly:
        UnhookWindowsHookEx hHook
     
    End Function

    E use a chamada abaixo para utiliza-lo:

    Sub Teste()
        MsgBox InputBoxDK("Digite sua senha", "Atenção", "123456")
    End Sub

    Att,


    Giovani Cruzara – Microsoft Contingent Staff

    Esse conteúdo é fornecido sem garantias de qualquer tipo, seja expressa ou implícita.

    Msdn Community Support

    Por favor, lembre-se de “Marcar como Resposta” as respostas que resolveram o seu problema. Essa é uma maneira comum de reconhecer aqueles que o ajudaram e fazer com que seja mais fácil para os outros visitantes encontrarem a resolução mais tarde.

    quarta-feira, 28 de agosto de 2013 17:10
  • No seu caso, sugiro que crie um formulário com um rótulo, botão de comando e uma caixa de texto que simule uma janela de diálogo para inserir a senha. Clique na caixa de texto e altere a propriedade PasswordChar para *

    Adicione o código abaixo no formulário:

    Private Sub CommandButton1_Click()
        Me.Hide
    End Sub

    Então, adicione o código abaixo num módulo comum:

    Sub fncMain()
        If fncSenha("benzadeus") = True Then
            MsgBox "Senha correta."
        Else
            MsgBox "Senha incorreta."
        End If
    End Sub
    
    Function fncSenha(str As String) As Boolean
        Dim frm As UserForm1
        
        Set frm = New UserForm1
        frm.Show
        On Error Resume Next
        If frm.TextBox1 = str Then fncSenha = True
    End Function

    Execute a subrotina fncMain e teste a senha benzadeus




    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    quarta-feira, 28 de agosto de 2013 22:42
    Moderador

Todas as Respostas

  • Olá ,

    Adicione o código abaixo a um módulo:

    'API functions to be used
    Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, _
                                                          ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
     
    Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" ( _
                                             ByVal lpModuleName As String) As Long
     
    Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" ( _
                                              ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) _
                                              As Long
     
    Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
     
    Private Declare Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" ( _
                                                ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, ByVal wParam As Long, _
                                                ByVal lParam As Long) As Long
     
    Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, _
                                                                              ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
     
    Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
     
    'Constants to be used in our API functions
    Private Const EM_SETPASSWORDCHAR = &HCC
    Private Const WH_CBT = 5
    Private Const HCBT_ACTIVATE = 5
    Private Const HC_ACTION = 0
     
    Private hHook As Long
     
    Public Function NewProc(ByVal lngCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
     
        Dim RetVal
        Dim strClassName As String, lngBuffer As Long
     
        If lngCode < HC_ACTION Then
            NewProc = CallNextHookEx(hHook, lngCode, wParam, lParam)
            Exit Function
        End If
     
        strClassName = String$(256, " ")
        lngBuffer = 255
     
        If lngCode = HCBT_ACTIVATE Then    'A window has been activated
            RetVal = GetClassName(wParam, strClassName, lngBuffer)
            If Left$(strClassName, RetVal) = "#32770" Then    'Class name of the Inputbox
                'This changes the edit control so that it display the password character *.
                'You can change the Asc("*") as you please.
                SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*"), &H0
            End If
        End If
     
        'This line will ensure that any other hooks that may be in place are
        'called correctly.
        CallNextHookEx hHook, lngCode, wParam, lParam
     
    End Function
     
    '// Make it public = avail to ALL Modules
    '// Lets simulate the VBA Input Function
    Public Function InputBoxDK(Prompt As String, Optional Title As String, Optional Default As String, _
                               Optional Xpos As Long, Optional Ypos As Long, Optional Helpfile As String, _
                               Optional Context As Long) As String
     
        Dim lngModHwnd As Long, lngThreadID As Long
     
        '// Lets handle any Errors JIC! due to HookProc> App hang!
        On Error GoTo ExitProperly
        lngThreadID = GetCurrentThreadId
        lngModHwnd = GetModuleHandle(vbNullString)
     
        hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID)
        If Xpos Then
            InputBoxDK = InputBox(Prompt, Title, Default, Xpos, Ypos, Helpfile, Context)
        Else
            InputBoxDK = InputBox(Prompt, Title, Default, , , Helpfile, Context)
        End If
     
    ExitProperly:
        UnhookWindowsHookEx hHook
     
    End Function

    E use a chamada abaixo para utiliza-lo:

    Sub Teste()
        MsgBox InputBoxDK("Digite sua senha", "Atenção", "123456")
    End Sub

    Att,


    Giovani Cruzara – Microsoft Contingent Staff

    Esse conteúdo é fornecido sem garantias de qualquer tipo, seja expressa ou implícita.

    Msdn Community Support

    Por favor, lembre-se de “Marcar como Resposta” as respostas que resolveram o seu problema. Essa é uma maneira comum de reconhecer aqueles que o ajudaram e fazer com que seja mais fácil para os outros visitantes encontrarem a resolução mais tarde.

    quarta-feira, 28 de agosto de 2013 17:10
  • No seu caso, sugiro que crie um formulário com um rótulo, botão de comando e uma caixa de texto que simule uma janela de diálogo para inserir a senha. Clique na caixa de texto e altere a propriedade PasswordChar para *

    Adicione o código abaixo no formulário:

    Private Sub CommandButton1_Click()
        Me.Hide
    End Sub

    Então, adicione o código abaixo num módulo comum:

    Sub fncMain()
        If fncSenha("benzadeus") = True Then
            MsgBox "Senha correta."
        Else
            MsgBox "Senha incorreta."
        End If
    End Sub
    
    Function fncSenha(str As String) As Boolean
        Dim frm As UserForm1
        
        Set frm = New UserForm1
        frm.Show
        On Error Resume Next
        If frm.TextBox1 = str Then fncSenha = True
    End Function

    Execute a subrotina fncMain e teste a senha benzadeus




    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    quarta-feira, 28 de agosto de 2013 22:42
    Moderador