Foto em Relatório

[Eduardo Engemann]

Caros amigos

to com um outro problema em meu Banco de dados, tenho uma tabela (Database) com um campo Localfoto), neste fica armazenado o camonho onde as fotos inseridas através do formulario cadastro, no formulario todo esta ocorrendo normalmente, mas o problema e ao gerar o relatório não to conseguindo fazer as fotos aparecerem já tentei o seguinte e não esta funcionando não sei porque.

1 no Relatório inseri um Objeto Imagem, com o nome Foto2

2 Na seção detalhes dete relatório priedade na aba eventos na opção Ao Formatar inseri o seguinte código:

Private Sub Detalhe_Format(Cancel As Integer, FormatCount As Integer)

Me!Foto2.Picture = Me!Localfoto

End Sub

Foto2 - Objeto Imagem que aparece a foto

Localfoto - campo da tabela Database onde o caminho da foto esta armazenada

Mas ao abrir ou executar o formulario da erro e tarja de amarelo o código acima

Alguém por favor poderia me ajudar já visitei uma porção de sites foruns e nada de nadicas consigo implementar e fazer a foto aparecer.

Ela sera amazenada em diversos formatos o codigo de inserir a fóto é o seguinte:

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

Foto - Objeto Imagem que aparece a foto

Localfoto - campo da tabela Database onde o caminho da foto esta armazenada

E tenho um procedimento em Modulo de nome Localizar o neúdo é o seguinte:

Option Compare Database

Public Type OPENFILENAME

lStructSize As Long

hwndOwner As Long

hInstance As Long

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 Long

lpfnHook As Long

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 Function GetOpenFileName Lib "comdlg32.dll" _

Alias "GetOpenFileNameA" (lpofn As OPENFILENAME) As Long

Public Declare 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 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 Function FindWindow Lib "user32" Alias _

"FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As Long) As Long

Public Declare 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

Obrigaado a todos que puderem me dar uma solução e me ajudarem.

Fiquem com Deus.

Eduardo Engemann

contato: eduardo.engemann@gmail.com