MaximoAccess

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

Obrigado

Administração do MaximoAccess

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

    [Resolvido]Erro ao anexar fotos 64bit

    Compartilhe

    paulopartica
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 34
    Registrado : 22/06/2013

    [Resolvido]Erro ao anexar fotos 64bit

    Mensagem  paulopartica em 18/4/2018, 01:54

    Boa noite amigos, estou com problemas para anexar fotos no formulário do access 64bit, alguém já conseguiu deixar o código do modulo localizar funcional para o access 64bit? Conforme algumas pesquisas ja fiz alterações no codigo troquei o Long por LongPtr no Declare inseri o PtrSafe para o 64bit mas não resolveu, no access 2010 32bit funciona perfeitamente, ja no access 2013 64bit não chega a abrir a caixa para pesquisar a foto.

    Uso o codigo abaixo e nomeio o mesmo como localizar em um modulo:

    Código:
    Option Compare Database

    Public Type OPENFILENAME
    lStructSize As LongPtr
    hwndOwner As LongPtr
    hInstance As LongPtr
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustomFilter As LongPtr
    nFilterIndex As LongPtr
    lpstrFile As String
    nMaxFile As LongPtr
    lpstrFileTitle As String
    nMaxFileTitle As LongPtr
    lpstrInitialDir As String
    lpstrTitle As String
    flags As LongPtr
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustData As LongPtr
    lpfnHook As LongPtr
    lpTemplateName As String
    End Type

    Public Const OFN_FILEMUSTEXIST = &H1000
    Public Const OFN_HIDEREADONLY = &H4
    Public Const OFN_PATHMUSTEXIST = &H800
    Const cTAMANHO = 11
    Public Declare PtrSafe Function GetOpenFileName Lib "comdlg32.dll" _
       Alias "GetOpenFileNameA" (lpofn As OPENFILENAME) As LongPtr
    Public Declare PtrSafe Function GetPrivateProfileString Lib "kernel32" Alias _
       "GetPrivateProfileStringA" (ByVal lpApplicationName As String, _
       ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, _
       ByVal nSize As LongPtr, ByVal lpFileName As String) As LongPtr
    Public Declare PtrSafe Function WritePrivateProfileString Lib "kernel32" Alias _
       "WritePrivateProfileStringA" (ByVal lpApplicationName As String, _
       ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As LongPtr
    Public Declare PtrSafe Function FindWindow Lib "user32" Alias _
       "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As LongPtr) As LongPtr
    Public Declare PtrSafe Function SendMessage Lib "user32" Alias _
       "SendMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As LongPtr, _
       ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
       

    Public Function Buscar(lngHwnd As LongPtr, strTítulo As String, strPastaInicial As String, strFiltro As String) As String
       
       Dim filebox As OPENFILENAME
       Dim result As LongPtr
       With filebox
           .lStructSize = Len(filebox)
           .hwndOwner = lngHwnd
           .hInstance = 0
           .lpstrFilter = strFiltro & vbNullChar & _
               "Todos os Arquivos (*.*)" & vbNullChar & "*.*" & vbNullChar & vbNullChar
           .nMaxCustomFilter = 0
           .nFilterIndex = 1
           .lpstrFile = Space(256) & vbNullChar
           .nMaxFile = Len(.lpstrFile)
           .lpstrFileTitle = Space(256) & vbNullChar
           .nMaxFileTitle = Len(.lpstrFileTitle)
           .lpstrInitialDir = strPastaInicial & vbNullChar
           .lpstrTitle = strTítulo & vbNullChar
           .flags = OFN_PATHMUSTEXIST Or OFN_FILEMUSTEXIST Or OFN_HIDEREADONLY
           .nFileOffset = 0
           .nFileExtension = 0
           .lCustData = 0
           .lpfnHook = 0
       End With

       result = GetOpenFileName(filebox)
       If result <> 0 Then
           Buscar = Left(filebox.lpstrFile, InStr(filebox.lpstrFile, vbNullChar) - 1)
       Else
           Buscar = ""
       End If

    End Function

    Para o boato de upload da foto uso o codigo abaixo:

    Código:
    Private Sub Foto_Click()
       Dim strCaminho As String, strPastaInicial As String
       strPastaInicial = "C:\Meus Documentos"
       strCaminho = Buscar(Me.hwnd, "Inserir foto", strPastaInicial, _
       "Arquivos gráficos (*.bmp; *.gif; *.jpg)" & vbNullChar & "*.bmp; *.gif; *.jpg")
       If Len(strCaminho) > 0 Then
           Me.LocalFoto = strCaminho
           Me.Foto.Picture = Me.LocalFoto
       End If

    End Sub

    Estou anexando o BD para algum amigo me ajudar a verificar isso, pois conforme falei no 32bi funciona ja no access 2013 64bit não acontece nada quando clico no quadrado de inserção de fotos.

    Agradeço muito a ajuda de vocês.
    Anexos
    Banco de dados2.zip
    Você não tem permissão para fazer download dos arquivos anexados.
    (89 Kb) Baixado 15 vez(es)
    avatar
    ahteixeira
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

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

    Re: [Resolvido]Erro ao anexar fotos 64bit

    Mensagem  ahteixeira em 18/4/2018, 11:50

    Olá Paulo,

    Para o que pretende, deve ajustar o código para funcionar também em 64bit.
    Tema diversas vezes abordado e com exemplos, veja:
    [Você precisa estar registrado e conectado para ver este link.]

    No entanto se não se quiser aventurar para já na alteração do código , pode usar o filedialog para o que pretende, veja:
    [Você precisa estar registrado e conectado para ver este link.]
    [Você precisa estar registrado e conectado para ver este link.]

    Abraço


    Última edição por ahteixeira em 17/9/2018, 14:24, editado 1 vez(es)

    paulopartica
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 34
    Registrado : 22/06/2013

    Re: [Resolvido]Erro ao anexar fotos 64bit

    Mensagem  paulopartica em 18/4/2018, 12:22

    Teixeira obrigado pela resposta, mas ja pesquisei no forum e na internet fiz as mudanças e nao consegui resolver o problema, eu tenho pouco conhecimento nos codigos VBA eu precisava que alguem me ajuda-se neste meu codigo postado acima deixei até um exemplo do BD em anexo, tenho certeza que para o feras do access aqui do blog deve ser muito facil fazer isso, mas eu até o momento não consegui.
    avatar
    ahteixeira
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

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

    Re: [Resolvido]Erro ao anexar fotos 64bit

    Mensagem  ahteixeira em 18/4/2018, 13:13

    Olá Paulo,

    Não é Fera, mas aqui no MaximoAccess vai ser!

    Adaptei atraves de outro exemplo do fórum:
    [Você precisa estar registrado e conectado para ver este link.]

    Veja como ficou o código:
    Código:
    Private Sub Foto_Click()
    On Error GoTo PROC_ERR

        ' Requer referencia a Microsoft Office 11 Object Library
        Dim fd As FileDialog
        Set fd = Application.FileDialog(msoFileDialogFilePicker)
        
        fd.Title = "selecione o ficheiro da imagem"
        fd.Filters.Add "Arquivos de imagem", "*.bmp; *.gif; *.jpg", 1

        fd.Show
        
        If (fd.SelectedItems.Count > 0) Then
            Me.LocalFoto = fd.SelectedItems(1)
            Me.Foto.Picture = fd.SelectedItems(1)
        Else
            MsgBox "Não foi escolhido nenhum ficheiro", vbInformation, ""
        End If
        
        
    PROC_EXIT:
        Exit Sub
        
    PROC_ERR:
        DoCmd.Hourglass False
            MsgBox Err.Number & " - " & Err.Description
        Resume PROC_EXIT
        
    End Sub


    Não esquecer da referencia (duvidas ver link da minha ultima mensagem)

    Segue meu exemplo:
    cld.pt/dl/download/fc9bf8e0-9220-4e8b-bc62-0580963367ff/EscolherImagem.zip

    Abraço

    paulopartica
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 34
    Registrado : 22/06/2013

    Re: [Resolvido]Erro ao anexar fotos 64bit

    Mensagem  paulopartica em 18/4/2018, 14:05

    Nossa Teixeira, ficou o máximo mesmo, poxa que legal Deus te abençoe amigo, e o mais legal que neste código seu para inserir no botão de carregar, podemos deixar de lado o modulo_Localizar que estava me deixando quase louco.

    Obrigado mesmo amigo me salvou.
    avatar
    ahteixeira
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

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

    Re: [Resolvido]Erro ao anexar fotos 64bit

    Mensagem  ahteixeira em 18/4/2018, 14:40

    Olá Paulo, obrigado pelo retorno.
    Fico feliz por ter ajudado.

    Não se esqueça de dar o tópico como Resolvido, veja como fazer:
    [Você precisa estar registrado e conectado para ver este link.]

    Abraço

    paulopartica
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 34
    Registrado : 22/06/2013

    Re: [Resolvido]Erro ao anexar fotos 64bit

    Mensagem  paulopartica em 18/4/2018, 14:46

    Muito grato.
    avatar
    ahteixeira
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

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

    Re: [Resolvido]Erro ao anexar fotos 64bit

    Mensagem  ahteixeira em 30/4/2018, 17:56

    cheers

      Data/hora atual: 22/10/2018, 00:36