[Resolvido]Inserir foto em um formulário e visualizá-las em um relatório

Boa noite!

Utilizo o office 2013 e Sistema operacional de 64 bits.

Fiz uma pesquisa no fórum e encontrei um exemplo interessante que insere foto em formulários, porém está dando o seguinte erro no módulo:
Erro de compilação:
O código desse projeto deve atualizado para o uso em sistema de 64 bits. Analise e atualize as instruções Declare e, em seguida, marque-as com o atributo PtrSafe.



Esse é o link do exemplo:
http://maximoaccess.forumeiros.com/t10008-colocar-foto-em-formulario

Alguém pode atualizar esse código pra mim, por favor?
Ainda não entendo muito de VBA.

Em anexo também, está o meu formulário baseado no exemplo do fórum.

Desde já agradeço.

Olá,

Neste Link você

vai encontrar a adaptação para o uso da API GetOpenFileName em 64 bits

Sds,

Amigo!
Dei uma olhada no link, porém tenho pouquíssima afinidade com vba...

Não consegui fazer as adaptações

Agradeço a ajuda

Amigo,

Abaixo tem o codigo adaptado para usar nos dois ambientes:

Basta substituí-lo no seu modulo.

Código:


Option Compare Database
Option Explicit

#If VBA7 Then

    Public Declare PtrSafe Function GetOpenFileName Lib "comdlg32.dll" Alias _
            "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long

    Public Type OPENFILENAME
      lStructSize As Long
      hwndOwner As Long
      hInstance As Long
      lpstrFilter As String
      lpstrCustomFilter As String
      nMaxCustFilter 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 Long
      lpfnHook As Long
      lpTemplateName As String
    End Type

#Else

    Public Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
            "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long

    Public Type OPENFILENAME
      lStructSize As Long
      hwndOwner As Long
      hInstance As Long
      lpstrFilter As String
      lpstrCustomFilter As String
      nMaxCustFilter 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 Long
      lpfnHook As Long
      lpTemplateName As String
    End Type

#End If

'/////////////////////////////////
'// End code GetOpenFileName    //
'/////////////////////////////////



'Declare Function apiGetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (OPENFILENAME As tagOPENFILENAME) As Long
''
Dim OPENFILENAME As OPENFILENAME
Public Const OFN_READONLY = &H1
Public Const OFN_OVERWRITEPROMPT = &H2
Public Const OFN_HIDEREADONLY = &H4
Public Const OFN_NOCHANGEDIR = &H8
Public Const OFN_SHOWHELP = &H10
Public Const OFN_ENABLEHOOK = &H20
Public Const OFN_ENABLETEMPLATE = &H40
Public Const OFN_ENABLETEMPLATEHANDLE = &H80
Public Const OFN_NOVALIDATE = &H100
Public Const OFN_ALLOWMULTISELECT = &H200
Public Const OFN_EXTENSIONDIFFERENT = &H400
Public Const OFN_PATHMUSTEXIST = &H800
Public Const OFN_FILEMUSTEXIST = &H1000
Public Const OFN_CREATEPROMPT = &H2000
Public Const OFN_SHAREAWARE = &H4000
Public Const OFN_NOREADONLYRETURN = &H8000
Public Const OFN_NOTESTFILECREATE = &H10000
Public Const OFN_NONETWORKBUTTON = &H20000
Public Const OFN_NOLONGNAMES = &H40000                      '  force no long names for 4.x modules
Public Const OFN_EXPLORER = &H80000                        '  new look commdlg
Public Const OFN_NODEREFERENCELINKS = &H100000
Public Const OFN_LONGNAMES = &H200000                      '  force long names for 3.x modules

Public Const OFN_SHAREFALLTHROUGH = 2
Public Const OFN_SHARENOWARN = 1
Public Const OFN_SHAREWARN = 0

'
'-------------------------------------------------------
' Open Common Dialog Function
'-------------------------------------------------------
Function OpenCommDlg()
Dim message$, Filter$, FileName$, FileTitle$, DefExt$
Dim Title$, szCurDir$, APIResults&
'
Filter$ = "Imagens (GIF,PCX,BMP,JPG)" & Chr$(0) & "*.BMP;*.GIF;*.PCX;*.JPG;" & Chr$(0) & _
        "Todos os ficheiros (*.*)" & Chr(0) & "*.*;" & Chr(0)
Filter$ = Filter$ & Chr$(0)
'
FileName$ = Chr$(0) & Space$(255) & Chr$(0)
FileTitle$ = Space$(255) & Chr$(0)
'* Give the dialog a caption title.
Title$ = "Selecionar imagem" & Chr$(0)
'
DefExt$ = "BMP" & Chr$(0)  ' extensión por defecto
szCurDir$ = CurDir$ & Chr$(0)  ' directorio por defecto, el actual
'* Set up the data structure before you call the GetOpenFileName
OPENFILENAME.lStructSize = Len(OPENFILENAME)
'If the OpenFile Dialog box is linked to a form use this line.
'It will pass the forms window handle.
OPENFILENAME.hwndOwner = Screen.ActiveForm.hwnd
'If the OpenFile Dialog box is not linked to any form use this line.
'It will pass a null pointer.
'OPENFILENAME.hwndOwner = 0&
OPENFILENAME.lpstrFilter = Filter$
OPENFILENAME.nFilterIndex = 1
OPENFILENAME.lpstrFile = FileName$
OPENFILENAME.nMaxFile = Len(FileName$)
OPENFILENAME.lpstrFileTitle = FileTitle$
OPENFILENAME.nMaxFileTitle = Len(FileTitle$)
OPENFILENAME.lpstrTitle = Title$
OPENFILENAME.flags = OFN_FILEMUSTEXIST Or OFN_READONLY Or OFN_PATHMUSTEXIST Or OFN_FILEMUSTEXIST
OPENFILENAME.lpstrDefExt = DefExt$
OPENFILENAME.hInstance = 0
OPENFILENAME.lpstrCustomFilter = String(255, 0)
OPENFILENAME.nMaxCustFilter = 255
OPENFILENAME.lpstrInitialDir = ("C:\EasyAgenda1.0\MinhasFotos")
OPENFILENAME.nFileOffset = 0
OPENFILENAME.nFileExtension = 0
OPENFILENAME.lCustData = 0
OPENFILENAME.lpfnHook = 0
OPENFILENAME.lpTemplateName = 0

If GetOpenFileName(OPENFILENAME) <> 0 Then
    OpenCommDlg = Left$(OPENFILENAME.lpstrFile, InStr(OPENFILENAME.lpstrFile, Chr$(0)) - 1)
Else
    OpenCommDlg = ""
End If
End Function


Sds,

Boa tarde!

Amigo Chsestrem... eu substitui o código, realmente não deu mais a mensagem de erro que dava antes, porém o botão de comando pra inserir foto no formulário, não tá executando nenhuma função...

Alguém tem algum exemplo que insira foto em formulário?

Amigo,

Não vejo a necessidade de se usar uma API para simplesmente abrir uma caixa de diálogo.

O Office tem função nativa para isto.

Como sugestão use a função abaixo ao invés da API.

Abra o módulo da API e comete todas as linhas.

Para o uso da função você de marcar a referência no seu projeto:

Use Alt + F11 / Referências e procure a referência do Office se não estiver marcada.


Se for Access 2007 ----> Microsoft Office 12 Object.Libray
Se for Access 2010 ----> Microsoft Office 14 Object.Libray

Cole a Função em um módulo:

Código:


Public Function fncLocalizarArquivo()
Dim fd As Office.FileDialog
On Error GoTo TrataErro
Set fd = Application.FileDialog(msoFileDialogOpen)
With fd
    With .Filters
        .Clear
        .Add "Fotos", "*.bmp" & ";" & "*.jpg" & ";" & "*.jpeg", 1 'USE AQUI A EXTENSÃO QUE LHE FOR MAIS CONVENIENTE
        .Add "Todos", "*.*", 2
    End With
    .Title = "Selecionar Foto"
    .AllowMultiSelect = False
    .InitialFileName = "c:\"            'Comente esta linha se quiser qua a cx abra no último diretório visitado
    .InitialView = msoFileDialogViewPreview
    If .Show Then
        fncLocalizarArquivo = .SelectedItems(1)
    End If
End With
sair:
    Exit Function
TrataErro:
    fncLocalizarArquivo = ""
    Resume sair:
End Function


Para usar a função acima substitua código do botão Buscar Foto:

por este:

Código:


Private Sub btnBuscaFoto_Click()
Dim s As String

's = OpenCommDlg()    'Linha que foi comentada da API

'Foi substituida pela linha abaixo.

s = fncLocalizarArquivo


If s <> "" Then
    Foto = s
    foto_AfterUpdate
End If

End Sub



Problema resolvido e muitíssimo obrigado meu caro...

Perdão pelo trabalho... tô começando aprender VBA...

O trabalho que vocês fazem aqui no fórum, nos estimula cada vez mais...

Um dia eu chego lá...

Obrigado de verdade!

Boa noite!
Amigo Chsestrem... fiz um formulário baseado no código que você me enviou, agora estou com uma dúvida...

Como eu faria pra criar um relatório que retornasse as fotos inseridas no formulário, sendo que na tabela só fica registrado o caminho delas?

Você pode me ajudar?

Bom dia,

Crie por exemplo uma consulta com os campos da tabela.

codFoto
caminhoFoto

depois é só criar um formulário do tipo contínuo.

Neste formulário contínuo inclua no detalhe um controle de Imagem e

nas propriedades do controle / aba Dados / Fonte de registro, referencie para CaminhoFoto

Ao abrir o formulário você vai poder visualizar todas as fotos.

Se for para visualizar uma a uma, crie o formulário Simples ao invés de contínuo.

Sds,

Muitíssimo obrigado!

Resolvido.

Boa noite!

chsestrem, você pode me ajudar em mais um detalhe relacionado à esse tópico?

As fotos nos relatórios, ficam desfocadas...

Tem alguma dica pra corrigir esse problema?

Se for possível ajudar, desde já agradeço!

Bom dia,

Nas propriedades do controle de imagem existem alguns parâmetros como Zoom, Expandido, Corte, etc...

Veja em qual parâmetro fica com melhor visualização

Sds,

Bom dia!

Eu coloquei como zoom, é o que melhor me atende...
O que acontece é o seguinte: As fotos ficam excelentes quando abro no modo de exibição de relatórios, porém quando abro no modo de visualização de impressão, elas desfocam e ficam meio borradas...

Alguém pode me ajudar?

Resolvido

Windows 10 64 bits
Office 2013


Olá!
Tbm migrei para 64 bits e estou com os mesmos problemas que o colaboradorpa teve, além de não conhecer bem VBA.
Fiz conforme a orientação do colega chsestrem, mas deu um erro.
O que está errado?



Alguém pode me ajudar?

Olá mestre Avelino!

A referência Microsoft Office 15 Object Libray está ativada.

Olá mestre Avelino!

está rodando certinho o sistema.
Muito obrigado meu caro!

Resolvido