Tenha um formulario de cadastro de produto neste cadastro tenho um botao que busca a imagem do sistema e joga num quadro, ate ai tudo certo, a imagem aparece normalmente.
Mas quando navego nos registro as imagens somem ou quando saio do formulario e abro de novo e nao ta mais la.
Mas a caixa de texto localfoto. Esta dizendo o caminho da foto normalmente, informando que a imagem ja esta inserida.
Este codigo peguei aqui no forom, mas nao me lembro quem foi o autor.
segue linha de codigo:
Modulo
Option Compare Database
' MODO DE LOCALIZAR IMAGEM
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
No meu formulario tenho uma caixa de texto com o nome de LocalFoto, um botao com o codigo ao clicar:
Private Sub btnLocalizar_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
E tenho um quadro com o nome de Foto, é aonde é armazenado a foto.
Alguem pode me ajudar
Desde ja agradeço contribuição de todos
Mas quando navego nos registro as imagens somem ou quando saio do formulario e abro de novo e nao ta mais la.
Mas a caixa de texto localfoto. Esta dizendo o caminho da foto normalmente, informando que a imagem ja esta inserida.
Este codigo peguei aqui no forom, mas nao me lembro quem foi o autor.
segue linha de codigo:
Modulo
Option Compare Database
' MODO DE LOCALIZAR IMAGEM
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
No meu formulario tenho uma caixa de texto com o nome de LocalFoto, um botao com o codigo ao clicar:
Private Sub btnLocalizar_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
E tenho um quadro com o nome de Foto, é aonde é armazenado a foto.
Alguem pode me ajudar
Desde ja agradeço contribuição de todos