MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

Obrigado

Administração do MaximoAccess

MaximoAccess

Gostaria de reagir a esta mensagem? Crie uma conta em poucos cliques ou inicie sessão para continuar.

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access

    [Resolvido]Erro de Compilacao

    tauron
    tauron
    VIP
    VIP

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 1224
    Registrado : 07/12/2011

    [Resolvido]Erro de Compilacao Empty [Resolvido]Erro de Compilacao

    Mensagem  tauron em 15/9/2019, 12:46

    Utilizo esse modulo "bas_maiuscula" (não me lembro de quem peguei o modelo) para que a primeira letra de cada palavra fique maiuscula (Ex.: Jose Antonio de Souza, Cento e Trinta Reais e Quarenta Centavos, Rio de Janeiro):

    Código:
    Public Function Proper(nome As String) As String
    '---------------------------------------------------------------
    ' Passe a variável a ser modificada em Nome e receba
    ' o retorno com a primeira letra em maiúscula.
    '
    '
    Dim Verificando As Boolean
    Dim i As Integer
    Dim ch As String
    Dim chespeciais As String
    Dim chespeciais1 As String
    Dim NomeReserva As String

       nome = LCase(nome)
       Verificando = True
       For i = 1 To Len(nome)
           ch = Mid$(nome, i, 1)
           If (ch >= "a" And ch <= "z") Or (ch >= "à" And ch <= "ü") Then
               If Verificando = True Then
                   Mid$(nome, i, 1) = UCase(ch)
                   Verificando = False
               End If
           Else
               Verificando = True
           End If
       Next i

       NomeReserva = nome

       Verificando = True
       For i = 1 To Len(NomeReserva)
           ch = Mid$(NomeReserva, i, 4)
           chespeciais = Mid$(NomeReserva, i, 5)
           If (ch = " De " Or ch = " Di " Or ch = " Da " Or ch = " Do " Or ch = " Du ") Or _
              (chespeciais = " Das " Or chespeciais = " Du " Or chespeciais = " Dos ") Then
               If Verificando = True Then
                   Mid$(NomeReserva, i, 2) = LCase(ch)
                   Verificando = False
               End If
           Else
               Verificando = True
           End If
       Next i

       NomeReserva = NomeReserva

       Verificando = True
       For i = 1 To Len(NomeReserva)
           chespeciais1 = Mid$(NomeReserva, i, 3)
           If chespeciais1 = " E " Then
               If Verificando = True Then
                   Mid$(NomeReserva, i, 2) = LCase(chespeciais1)
                   Verificando = False
               End If
           Else
               Verificando = True
           End If
       Next i

       Proper = NomeReserva
    End Function

    E estes modulos "basproper" e "mod_imputbox" (do modelo "Se não estiver na lista" do Assis):
    Código:
    Function CapitalizeFirst(X)

        Dim Temp
        Temp = Trim(X)
        CapitalizeFirst = UCase(Left(Temp, 1)) & Mid(Temp, 2)

    End Function

    Function LowerCase(X)

        Dim Temp
        Temp = Trim(X)
        LowerCase = LCase(Temp)


    End Function

    Function Proper(X)


        Dim Temp$, C$, OldC$, I As Integer
        If IsNull(X) Then
            Exit Function
        Else
            Temp$ = CStr(LCase(X))

            OldC$ = " "
            For I = 1 To Len(Temp$)
                C$ = Mid$(Temp$, I, 1)
                If C$ >= "a" And C$ <= "z" And (OldC$ < "a" Or OldC$ > "z") Then
                    Mid$(Temp$, I, 1) = UCase$(C$)
                End If
                OldC$ = C$
            Next I
            Proper = Temp$
        End If
    End Function

    e

    Código:
    Option Compare Database
    '////////////////////////////////////////////////////////////////////
    'Password masked inputbox
    'Allows you to hide characters entered in a VBA Inputbox.
    '




    'API functions to be used
    Private Declare PtrSafe Function CallNextHookEx _
    Lib "User32" ( _
    ByVal hHook As Long, _
    ByVal ncode As Long, _
    ByVal wParam As Long, _
    lParam As Any) _
    As Long

    Private Declare PtrSafe Function GetModuleHandle _
    Lib "kernel32" _
    Alias "GetModuleHandleA" ( _
    ByVal lpModuleName As String) _
    As Long

    Private Declare PtrSafe 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 PtrSafe Function UnhookWindowsHookEx _
    Lib "User32" ( _
    ByVal hHook As Long) _
    As Long

    Private Declare PtrSafe 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 PtrSafe Function GetClassName _
    Lib "User32" _
    Alias "GetClassNameA" ( _
    ByVal hWnd As Long, _
    ByVal lpClassName As String, _
    ByVal nMaxCount As Long) _
    As Long

    Private Declare PtrSafe 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

    Mas ao utiliza-los no mesmo projeto, apresenta erro de compilacao "Nome repetido encontrado: Proper" .
    avatar
    zcarloslopes
    Avançado
    Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 295
    Registrado : 28/10/2010

    [Resolvido]Erro de Compilacao Empty Re: [Resolvido]Erro de Compilacao

    Mensagem  zcarloslopes em 16/9/2019, 11:16

    Bom dia,

    Tem um nome de função repetido:

    Código:
    Public Function Proper(nome As String) As String
    (...)

    e
    Código:
    Function Proper(X)
    (...)

    Tente o seguinte: altere o nome em uma das funções e ajuste a alteração

    Quando chamar a função alterada terá que ser com o novo nome.
    DamascenoJr.
    DamascenoJr.
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 2137
    Registrado : 22/11/2016

    [Resolvido]Erro de Compilacao Empty Re: [Resolvido]Erro de Compilacao

    Mensagem  DamascenoJr. em 29/3/2020, 15:41

    Tauron, e o retorno deste tópico?


    .................................................................................
    Ajude-se a ser ajudado, anexe seu projeto.
    Sempre tente entender o código,
    não somente copie e cole.
    Positive as mensagens que achar útil clicando no '+' no canto superior direito delas.
    tauron
    tauron
    VIP
    VIP

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 1224
    Registrado : 07/12/2011

    [Resolvido]Erro de Compilacao Empty Re: [Resolvido]Erro de Compilacao

    Mensagem  tauron em 30/3/2020, 20:56

    Então, ainda não consegui resolver este. Mas irei encerrar

      Data/hora atual: 10/8/2020, 07:12