MaximoAccess

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

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração


Participe do fórum, é rápido e fácil

MaximoAccess

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

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração

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

2 participantes

    [Resolvido]Botão buscar imagem do item.

    abjinfo
    abjinfo
    Intermediário
    Intermediário

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 116
    Registrado : 02/07/2015

    [Resolvido]Botão buscar imagem do item. Empty [Resolvido]Botão buscar imagem do item.

    Mensagem  abjinfo 25/6/2020, 18:43

    Olá Pessoal...

    Procurei sobre este assunto nos resolvidos, mais não encontrei.

    É o seguinte... tenho um formulário de produtos e nele tenho que colocar a imagem do mesmo.

    Coloquei um botão com a seguinte linhas VBA:

    ******************************************************

    Private Sub AdicionarFoto_Click()
       Dim strCaminho As String, strPastaInicial As String
       strPastaInicial = CurrentProject.Path & "\fotos\"
       strCaminho = Buscar(Me.hwnd, "Inserir foto", strPastaInicial, _
       "Arquivos gráficos (*.bmp; *.gif; *.jpg)" & vbNullChar & "*.bmp; *.gif; *.jpg")
       If Len(strCaminho) > 0 Then
           txtLocalLogo = strCaminho
           Me.Logo.Picture = txtLocalLogo
       End If
    End Sub

    ******************************************************

    Porem, quando clico no botão ele não retorna nada. Será que está faltando algum Suplemento?

    Fico no aguardo e obrigado.
    DamascenoJr.
    DamascenoJr.
    Moderador
    Moderador

    Respeito às regras : Respeito às Regras 100%

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

    [Resolvido]Botão buscar imagem do item. Empty Re: [Resolvido]Botão buscar imagem do item.

    Mensagem  DamascenoJr. 26/6/2020, 00:05



    .................................................................................
    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.
    abjinfo
    abjinfo
    Intermediário
    Intermediário

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 116
    Registrado : 02/07/2015

    [Resolvido]Botão buscar imagem do item. Empty Re: [Resolvido]Botão buscar imagem do item.

    Mensagem  abjinfo 29/7/2020, 03:20

    Olá Damasceno.
    Obrigado em responder e desculpa pela demora.

    Segui o link da msm n. 2 e fiz todas as mudanças de Ptr que vc sugeriu, mais infelizmente não funcionou. Ele não abre gerenciador de arquivo para escolher a imagem. Sad
    DamascenoJr.
    DamascenoJr.
    Moderador
    Moderador

    Respeito às regras : Respeito às Regras 100%

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

    [Resolvido]Botão buscar imagem do item. Empty Re: [Resolvido]Botão buscar imagem do item.

    Mensagem  DamascenoJr. 29/7/2020, 04:00

    Anexe seu projeto para análise.


    .................................................................................
    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.
    DamascenoJr.
    DamascenoJr.
    Moderador
    Moderador

    Respeito às regras : Respeito às Regras 100%

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

    [Resolvido]Botão buscar imagem do item. Empty Re: [Resolvido]Botão buscar imagem do item.

    Mensagem  DamascenoJr. 23/9/2020, 23:48

    abjinfo, algum avanço?

    Aguardamos seu retorno...


    .................................................................................
    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.
    DamascenoJr.
    DamascenoJr.
    Moderador
    Moderador

    Respeito às regras : Respeito às Regras 100%

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

    [Resolvido]Botão buscar imagem do item. Empty Re: [Resolvido]Botão buscar imagem do item.

    Mensagem  DamascenoJr. 25/8/2021, 00:58

    Alexandre, algum avanço?

    Ainda estamos aguardando...


    .................................................................................
    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.
    abjinfo
    abjinfo
    Intermediário
    Intermediário

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 116
    Registrado : 02/07/2015

    [Resolvido]Botão buscar imagem do item. Empty Re: [Resolvido]Botão buscar imagem do item.

    Mensagem  abjinfo 1/9/2021, 00:54

    Olá Damasceno...

    Desculpa na demora, é que fui convivendo com o problema e agora estou com um tempo para resolver.

    Bom.. vou postar o código por parte.
    ----------------------------------------------------------------
    Botão>

    Private Sub AdicionarFoto_Click()
       Dim strCaminho As String, strPastaInicial As String
       strPastaInicial = CurrentProject.Path & "\fotos\produtos\"
       strCaminho = Buscar(Me.hwnd, "Inserir foto", strPastaInicial, _
       "Arquivos gráficos (*.bmp; *.gif; *.jpg)" & vbNullChar & "*.bmp; *.gif; *.jpg")
       If Len(strCaminho) > 0 Then
           txtLocalFoto = strCaminho
           Me.Foto.Picture = txtLocalFoto
       End If
    End Sub
    ------------------------------------------------------------------

    Buscar>

    Option Compare Database
    Public Type OpenFilename
    lStructSize As Long
    hwndOwner As LongPtr
    hInstance As LongPtr
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustomFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    Flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustData As LongPtr
    lpfnHook As LongPtr
    lpTemplateName As String
    'lpTemplateName As Long
    pvReserved As LongPtr
    dwReserved As Long
    FlagsEx As Long
    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 Long
    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 Long, ByVal lpFileName As String) As Long
    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 Long
    Public Declare PtrSafe Function FindWindow Lib "user32" Alias _
       "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As Long) As Long
    Public Declare PtrSafe Function SendMessage Lib "user32" Alias _
       "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
       ByVal wParam As Long, ByVal lParam As Long) As Long

    Public Function Buscar(lngHwnd As Long, strTítulo As String, strPastaInicial As String, strFiltro As String) As String
       
       Dim filebox As OpenFilename
       Dim result As Long
       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

    ----------------------------------------------------------------------------------------------

    Revisei todo o código, inclusive com a sua sugestão e não abre.

    Versão do Access 64bits
    Windows 10.
    DamascenoJr.
    DamascenoJr.
    Moderador
    Moderador

    Respeito às regras : Respeito às Regras 100%

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

    [Resolvido]Botão buscar imagem do item. Empty Re: [Resolvido]Botão buscar imagem do item.

    Mensagem  DamascenoJr. 1/9/2021, 00:59



    .................................................................................
    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.
    abjinfo
    abjinfo
    Intermediário
    Intermediário

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 116
    Registrado : 02/07/2015

    [Resolvido]Botão buscar imagem do item. Empty Re: [Resolvido]Botão buscar imagem do item.

    Mensagem  abjinfo 1/9/2021, 01:31

    Ok.. obrigado em responder rapidamente.
    Vou verificar e retorno.

    study
    abjinfo
    abjinfo
    Intermediário
    Intermediário

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 116
    Registrado : 02/07/2015

    [Resolvido]Botão buscar imagem do item. Empty Re: [Resolvido]Botão buscar imagem do item.

    Mensagem  abjinfo 1/9/2021, 02:44

    cheers cheers

    Você realmente é muito bom.....
    Muito obrigado por compartilhar e nos ajudar, pois adaptei ao meu projeto e ficou bom.
    Como de praxe, vou colocar no projeto a sua colaboração com está rotina.
    Valeu DamascenoJr.
    DamascenoJr.
    DamascenoJr.
    Moderador
    Moderador

    Respeito às regras : Respeito às Regras 100%

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

    [Resolvido]Botão buscar imagem do item. Empty Re: [Resolvido]Botão buscar imagem do item.

    Mensagem  DamascenoJr. 1/9/2021, 03:22

    O fórum agradece o retorno. Sucesso.


    .................................................................................
    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.

      Data/hora atual: 23/9/2021, 01:26