MaximoAccess

Caro Usuário, não tire as suas duvidas nas Salas de Repositório, abra sempre um novo tópico relacionado, nas salas destinadas para o efeito, como Sala de Tabelas, Consultas, Formulários, Relatórios, Macros, Módulos e VBA.

Obrigado

Administração do MaximoAccess

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

    [Resolvido]Nome repetido. (Conflito de funções)

    Compartilhe

    wsenna
    Developer
    Developer

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 470
    Registrado : 22/12/2009

    [Resolvido]Nome repetido. (Conflito de funções)

    Mensagem  wsenna em Qui 09 Abr 2015, 12:23

    Olá Feras de plantão, bom dia.

    Tenho um problema que já me ocorreu diversas vezes em outros projetos e até hoje não consegui identificar a causa, explico:

    Acabo de inserir num projeto antigo um formulário que faz busca pelo cep. Este formulário funciona perfeitamente no BD de exemplo que baixei aqui mesmo deste Fórum.
    O problema é que neste formulário possui uma função que ao ser executada me surge a mensagem como abaixo.

    [img][Você precisa estar registrado e conectado para ver esta imagem.][/img]


    Certo é que possuo outros módulos que possuem o termo Split e não consigo perceber a correlação entre os módulos já existentes com a função acima demonstrada.

    Posso contar com a boa vontade dos Mestres?

    Um grande abraço, WSenna

    ahteixeira
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 3216
    Registrado : 15/03/2013

    Re: [Resolvido]Nome repetido. (Conflito de funções)

    Mensagem  ahteixeira em Sex 10 Abr 2015, 15:52

    Olá wsenna,
    Já tentou esse modulo numa base de dados nova? Separado do seu projecto.
    Outra forma será uma pesquisa, veja:
    [Você precisa estar registrado e conectado para ver esta imagem.]
    Caso não consiga, só mesmo disponibilizando o modulo.
    Abraço

    wsenna
    Developer
    Developer

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 470
    Registrado : 22/12/2009

    Re: [Resolvido]Nome repetido. (Conflito de funções)

    Mensagem  wsenna em Sex 10 Abr 2015, 16:10

    Grande Teixeira, bom dia.

    Como já havia dito acima, o modelo funciona numa base nova ou em qualquer outro projeto que não possua um módulo que contenha o termo Split.

    Já realizei a pesquisa como o Amigo sugeriu e observei quais outros módulos possuem este termo, o caso que me deixa encucado é que necessito desses outros módulos pois possuem funções diferentes, daí...

    Exemplos:

    modJustiRightOrCenter   'Este módulo tem por função alinhar no centro ou à direita as colunas de uma listbox.

    Option Compare Database
    Option Explicit

    'Authors:      Stephen Lebans
    '              Terry Kreft
    'Date:         Dec 14, 1999
    'Copyright:    Lebans Holdings (1999) Ltd.
    '              Terry Kreft
    'Use:          Center and Right Align data in
    '              List or Combo control's
    'Bugs:         Please me know if you find any.
    'Contact:      Stephen@lebans.com


    Private Type Size
           cx As Long
           cy As Long
    End Type

    Private Const LF_FACESIZE = 32

    Private Type LOGFONT
           lfHeight As Long
           lfWidth As Long
           lfEscapement As Long
           lfOrientation As Long
           lfWeight As Long
           lfItalic As Byte
           lfUnderline As Byte
           lfStrikeOut As Byte
           lfCharSet As Byte
           lfOutPrecision As Byte
           lfClipPrecision As Byte
           lfQuality As Byte
           lfPitchAndFamily As Byte
           lfFaceName As String * LF_FACESIZE
    End Type

    Private Declare Function apiCreateFontIndirect Lib "gdi32" Alias _
           "CreateFontIndirectA" (lplogfont As LOGFONT) As Long

    Private Declare Function apiSelectObject Lib "gdi32" _
    Alias "SelectObject" (ByVal hDC As Long, ByVal hObject As Long) As Long

    Private Declare Function apiGetDC Lib "User32" _
     Alias "GetDC" (ByVal hwnd As Long) As Long

    Private Declare Function apiReleaseDC Lib "User32" _
     Alias "ReleaseDC" (ByVal hwnd As Long, _
     ByVal hDC As Long) As Long

    Private Declare Function apiDeleteObject Lib "gdi32" _
     Alias "DeleteObject" (ByVal hObject As Long) As Long

    Private Declare Function apiGetTextExtentPoint32 Lib "gdi32" _
    Alias "GetTextExtentPoint32A" _
    (ByVal hDC As Long, ByVal lpsz As String, ByVal cbString As Long, _
    lpSize As Size) As Long

    ' Create an Information Context
    Declare Function apiCreateIC Lib "gdi32" Alias "CreateICA" _
     (ByVal lpDriverName As String, ByVal lpDeviceName As String, _
     ByVal lpOutput As String, lpInitData As Any) As Long
     
    ' Close an existing Device Context (or information context)
    Declare Function apiDeleteDC Lib "gdi32" Alias "DeleteDC" _
     (ByVal hDC As Long) As Long

    Private Declare Function GetSystemMetrics Lib "User32" (ByVal nIndex As Long) As Long

    Private Declare Function GetDeviceCaps Lib "gdi32" _
    (ByVal hDC As Long, ByVal nIndex As Long) As Long

    ' Constants
    Private Const SM_CXVSCROLL = 2
    Private Const LOGPIXELSX = 88



    '­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­ 
    ' 1) We now call the function with an Optional SubForm parameter. This is
    ' the name of the SubForm Control. If you used the Wizard to add the
    ' SubForm to the main Form then the SubForm control has the same name as
    ' the SubForm. But this is not always the case. For the benefit of those
    ' lurkers out there we must remember that the SubForm and the SubForm
    ' Control are two seperate entities. It's very straightforward, the
    ' SubForm Control houses the actual SubForm. Sometimes the have the same
    ' name, very confusing, or you can name the Control anything you want! In
    ' this case for clarity I changed the name of the SubForm Control to
    ' SFFrmJustify. Ugh..OK that's not too clear but it's late!

    ' So the adjusted SQL statement is now.
    ' CODENUM: JustifyString("FrmMain","List5",[code],0,True,"SFfrmJustify")
    '­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­ 



    ' ***CODE START
    Function JustifyString(myform As String, myctl As String, myfield As Variant, _
    col As Integer, RightOrCenter As Integer, Optional Sform As String = "") As Variant

    ' March 21, 2000
    ' Changes RightOrCenter to Integer from Boolean
    ' -1 = Right. 0 = Center, 1 = Left

    ' Called from UserDefined Function in Query like:
    ' SELECT DISTINCTROW JustifyString("frmJustify","list4",_
    ' [code],0,False) AS CODENUM, HORTACRAFT.NAME FROM HORTACRAFT;

    ' myform = name of form containing control
    ' myctl = name of control
    ' myfield is the actual data field from query we will Justify
    ' col = column of the control the data is to appear in(0 based index)
    ' RightOrCenter True = Right. False = Center

    Dim UserControl As Control
    Dim UserForm As Form
    Dim lngWidth As Long

    Dim intSize As Integer
    Dim strText As String
    Dim lngL As Long
    Dim strColumnWidths As String
    Dim lngColumnWidth As Long
    Dim lngScrollBarWidth As Long
    Dim lngOneSpace As Long
    Dim lngFudge As Long
    Dim arrCols() As String
    Dim lngRet As Long

    ' Add your own Error Handling
    On Error Resume Next

    ' Need fudge factor.
    ' Access allows for a margin in drawing its Controls.
    lngFudge = 60

    ' We need the Control as an Object
    ' Check and see if use passed SubForm or not
    If Len(Sform & vbNullString) > 0 Then
       Set UserForm = Forms(myform).Controls(Sform).Form
    Else
       Set UserForm = Forms(myform)
    End If

    ' Assign ListBox or Combo to our Control var
    Set UserControl = UserForm.Controls.Item(myctl)

    With UserControl
      If col > Split(arrCols(), .ColumnWidths, ";") Then Exit Function
      If col = .ColumnCount - 1 Then
        ' Add in the width of the scrollbar, which we get in pixels.
        ' Convert it to twips for use in Access.
        lngScrollBarWidth = GetSystemMetrics(SM_CXVSCROLL)
        lngScrollBarWidth = lngScrollBarWidth * (1440 / GetTwipsPerPixel())
      End If
      lngColumnWidth = Nz(Val(arrCols(col)), 1)
      lngColumnWidth = lngColumnWidth - (lngScrollBarWidth + lngFudge)
    End With

    ' Single space character will be used
    ' to calculate the number of SPACE characters
    ' we have to add to the Input String to
    ' achieve Right justification.
    strText = " "

    ' Call Function to determine how many
    ' Twips in width our String is
    lngWidth = StringToTwips(UserControl, strText)

    ' Check for error
    If lngWidth > 0 Then
          lngOneSpace = Nz(lngWidth, 0)
       
        ' Clear variables for next call
          lngWidth = 0
       
        ' Convert all variables to type string
        Select Case VarType(myfield)
       
        Case 1 To 6, 7
        ' It's a number(1-6) or 7=date
        strText = str$(myfield)
       
        Case 8
        ' It's a string..leave alone
        strText = myfield
       
        Case Else
        ' Houston, we have a problem
           Call MsgBox("Field type must be Numeric, Date or String", vbOKOnly)
       
        End Select
       
        'let's trim the string - better safe than sorry :-)
        strText = Trim$(strText)
       
        ' Call Function to determine how many
        ' Twips in width our String is
        lngWidth = StringToTwips(UserControl, strText)
       
        ' Check for error
        If lngWidth > 0 Then
       
           ' Calculate how many SPACE characters to append
           ' to our String.
           ' Are we asking for Right or Center Alignment?
            Select Case RightOrCenter
               Case -1
               ' Right
               strText = String(Int((lngColumnWidth - lngWidth) / lngOneSpace), " ") & strText
             
               Case 0
               ' Center
               strText = String((Int((lngColumnWidth - lngWidth) / lngOneSpace) / 2), " ") & strText _
                  & String((Int((lngColumnWidth - lngWidth) / lngOneSpace) / 2), " ")
             
                Case 1
               ' Left
               strText = strText
             
                Case Else
           End Select
              ' Return Original String with embedded Space characters
             JustifyString = strText
       End If
    End If

    ' Cleanup
    Set UserControl = Nothing
    Set UserForm = Nothing

    End Function



    Function Split(ArrayReturn() As String, ByVal StringToSplit As String, _      (Acredito que o problema possa estar nesta função)
    SplitAt As String) As Integer
      Dim intInstr As Integer
      Dim intCount As Integer
      Dim strTemp As String

      intCount = -1
      intInstr = InStr(StringToSplit, SplitAt)
      Do While intInstr > 0
        intCount = intCount + 1
        ReDim Preserve ArrayReturn(0 To intCount)
        ArrayReturn(intCount) = Left(StringToSplit, intInstr - 1)
        StringToSplit = Mid(StringToSplit, intInstr + 1)
        intInstr = InStr(StringToSplit, SplitAt)
      Loop
      If Len(StringToSplit) > 0 Then
        intCount = intCount + 1
        ReDim Preserve ArrayReturn(0 To intCount)
        ArrayReturn(intCount) = StringToSplit
      End If
      Split = intCount
    End Function
    '*************  Code End   *************


    Private Function StringToTwips(ctl As Control, strText As String) As Long
       Dim myfont As LOGFONT
       Dim stfSize As Size
       Dim lngLength As Long
       Dim lngRet As Long
       Dim hDC As Long
       Dim lngscreenXdpi As Long
       Dim fontsize As Long
       Dim hfont As Long, prevhfont As Long
       
       ' Get Desktop's Device Context
       hDC = apiGetDC(0&)
       
       'Get Current Screen Twips per Pixel
       lngscreenXdpi = GetTwipsPerPixel()
       
       ' Build our LogFont structure.
       ' This  is required to create a font matching
       ' the font selected into the Control we are passed
       ' to the main function.
       'Copy font stuff from Text Control's property sheet
       With myfont
           .lfFaceName = ctl.FontName & Chr$(0)  'Terminate with Null
           fontsize = ctl.fontsize
           .lfWeight = ctl.FontWeight
           .lfItalic = ctl.FontItalic
           .lfUnderline = ctl.FontUnderline
       
           ' Must be a negative figure for height or system will return
           ' closest match on character cell not glyph
           .lfHeight = (fontsize / 72) * -lngscreenXdpi
       End With
                                       
       ' Create our Font
       hfont = apiCreateFontIndirect(myfont)
       ' Select our Font into the Device Context
       prevhfont = apiSelectObject(hDC, hfont)
                   
       ' Let's get length and height of output string
       lngLength = Len(strText)
       lngRet = apiGetTextExtentPoint32(hDC, strText, lngLength, stfSize)
       
       ' Select original Font back into DC
       hfont = apiSelectObject(hDC, prevhfont)
       
       ' Delete Font we created
       lngRet = apiDeleteObject(hfont)
           
       ' Release the DC
       lngRet = apiReleaseDC(0&, hDC)
           
       ' Return the length of the String in Twips
       StringToTwips = stfSize.cx * (1440 / GetTwipsPerPixel())
           
    End Function


    Private Function GetTwipsPerPixel() As Integer

       ' Determine how many Twips make up 1 Pixel
       ' based on current screen resolution
       
       Dim lngIC As Long
       lngIC = apiCreateIC("DISPLAY", vbNullString, _
        vbNullString, vbNullString)
       
       ' If the call to CreateIC didn't fail, then get the info.
       If lngIC <> 0 Then
           GetTwipsPerPixel = GetDeviceCaps(lngIC, LOGPIXELSX)
           ' Release the information context.
           apiDeleteDC lngIC
       Else
           ' Something has gone wrong. Assume a standard value.
           GetTwipsPerPixel = 120
       End If
    End Function


    Já o que me refiro é este que faz uma busca on line pelo endereço após digitarmos o CEP desejado.


    Public Function busca_cep()
    URL = "http://republicavirtual.com.br/web_cep.php?cep=" & CEP & "&formato=query_string"

    Set xmlhttp = CreateObject("MSXML2.ServerXMLHTTP")
    xmlhttp.Open "GET", URL, False
    xmlhttp.Send ""

    xmlhttp_resultado = xmlhttp.responseText
    Set xmlhttp = Nothing

    arr_resultado = Split(xmlhttp_resultado, "&")

    Dim resultado(7)
    For i = LBound(arr_resultado) To UBound(arr_resultado)

    resultado(i) = arr_resultado(i)

    Next

    arr = Split(Join(resultado, "="), "=")

    Dim arr_2(14)
    For i = LBound(arr) To UBound(arr)

    arr_2(i) = Replace(arr(i), "+", " ")

    Next

    busca_cep = arr_2
    End Function


    Observe que em ambos possuem o termo Split, e que no primeiro código contém uma função com a denominação Split (marcado em vermelho) penso que este é o conflito.

    Abraços, WSenna

    ahteixeira
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 3216
    Registrado : 15/03/2013

    Re: [Resolvido]Nome repetido. (Conflito de funções)

    Mensagem  ahteixeira em Sex 10 Abr 2015, 16:40

    Olá, efectivamente o conflito está na linha que indicou:

    Function Split(ArrayReturn() As String, ByVal StringToSplit As String, _ (Acredito que o problema possa estar nesta função)

    Para resolver sou da opinião:

    1º - retirar o modulo novo que está a incluir do seu projecto (temporariamente)

    2º - Alterar o nome da sua função para isso pode utilizar o localizar e sunstituir

    fazendo substituir Split por SplitX em todo o seu projecto.

    pode também acontecer de ter consultas ou campos a ir buscar essa função (você saberá), também é necessário ajustar.

    3º Importar modulo novo.

    Abraço


    wsenna
    Developer
    Developer

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 470
    Registrado : 22/12/2009

    Re: [Resolvido]Nome repetido. (Conflito de funções)

    Mensagem  wsenna em Sex 10 Abr 2015, 23:47

    Grande Teixeira, boa noite.

    Amigão, era realmente esse o problema. Segui suas sugestões e a coisa bombou legal.

    Um grande abraço, WSenna

    ahteixeira
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 3216
    Registrado : 15/03/2013

    Re: [Resolvido]Nome repetido. (Conflito de funções)

    Mensagem  ahteixeira em Sex 10 Abr 2015, 23:58

    Olá Wsenna, obrigado pelo retorno.
    Abraço cheers

    Alexandre Neves
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 5889
    Registrado : 05/11/2009

    Re: [Resolvido]Nome repetido. (Conflito de funções)

    Mensagem  Alexandre Neves em Dom 12 Abr 2015, 18:54

    Faltou o Resolvido, Mestre. Já marquei


    .................................................................................
    Access 2010. Mande bd que dê para testar (indique a versão). Não peça para fazer o que já tem feito. Dê todos os detalhes.
    Não coloquem entraves como senhas, esconder controlos, etc. Disponibilizem o mais limpo possível
    Só respondo a mensagens privadas, se forem de assunto privado; às outras não respondo.
    Quem trabalha e mata a fome não come o pão de ninguém; mas quem não trabalha e come, come sempre o pão de alguém. António Aleixo

    wsenna
    Developer
    Developer

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 470
    Registrado : 22/12/2009

    Re: [Resolvido]Nome repetido. (Conflito de funções)

    Mensagem  wsenna em Dom 12 Abr 2015, 19:51

    Grande Alexandre, boa tarde.

    Amigão, perdoe-me o lapso.
    Receba um grande abraço e tenha uma ótima semana.

    WSenna

    Alexandre Neves
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 5889
    Registrado : 05/11/2009

    Re: [Resolvido]Nome repetido. (Conflito de funções)

    Mensagem  Alexandre Neves em Dom 12 Abr 2015, 21:01

    Tudo bem. Afinal, ainda lhe ficamos a dever muito.
    Agradeço e retribuo os desejos de óptima semana.
    Grande abraço.
    Alexandre


    .................................................................................
    Access 2010. Mande bd que dê para testar (indique a versão). Não peça para fazer o que já tem feito. Dê todos os detalhes.
    Não coloquem entraves como senhas, esconder controlos, etc. Disponibilizem o mais limpo possível
    Só respondo a mensagens privadas, se forem de assunto privado; às outras não respondo.
    Quem trabalha e mata a fome não come o pão de ninguém; mas quem não trabalha e come, come sempre o pão de alguém. António Aleixo

      Data/hora atual: Sex 09 Dez 2016, 07:39