(Resolvido) Carregando Foto Em Form

[BRUCCE]

beleza Galera!

Eu consegui um código para visualizar fotos em FORM, as fotos ficam salva em uma pasta, e atraves do endereço, é visualizada no FORM, mas esta dando um erro: Abaixo segue o código:

(A mensagem d erro é: ERRO DE COMPILAÇÃO - OTIPO DEFINIDO PELO USUARIO NOA FOI DEFINIDO...., e quando eu clico em depurar, aparece selecionado Dim CxDialog As Office.FileDialog

O que posso fazer para resolver?

1º Crie uma tabela com o seguintes campos, dê o nome que desejar:

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

Foto, Numeração Automática

Descricao, Texto, 50

Link, Texto, 255

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

2º Crie um formulário baseado nessa tabela

3º Insira um controle Imagem nesse formulário (selecione uma foto qualquer) e defina seu nome como imagem.

4º Insira um botão ao lado da caixa de texto Link

5º Acione a caixa de propriedades (F4) do seu botão e no procedimento do evento Ao clicar insira o código abaixo:

Private Sub MeuBotao_Click()

'É necessário fazer referência a Microsoft Office 11.0 Object Library

'em Ferramentas > Referências no Editor do Visual Basic

Dim CxDialog As Office.FileDialog

Set CxDialog = Application.FileDialog(msoFileDialogFilePicker)

With CxDialog

'define como seleção simples

.AllowMultiSelect = False

' Define o titulo da caixa de diálogo

.Title = "Selecione uma imagem"

' limpa os filtros

.Filters.Clear

'adiciona novos filtros

.Filters.Add "JPG", "*.jpg"

.Filters.Add "BMP", "*.bmp"

.Filters.Add "Todos os arquivos", "*.*"

'mostra a caixa de dialogo

If .Show = True Then 'se alguma imagem tiver sido escolhida

'atribuie o endereço da imagem ao campo link

Me.link = .SelectedItems(1)

'exibe a foto

me.Imagem.Visible = True

'carrega a foto

Me.Imagem.Picture = Me.link

End If

End With

End Sub

6º Vá no menu Ferramentas > Referências do Editor Visual basic e Marque a biblioteca

Microsoft Office 11.0 Object Library. Isso é imprescendível para o funcionamento da rotina.

Eu estou usando o Office 2003, de acordo com a sua versão pode ser outra, mas com o nome muito próximo a essa.

7º Volte ao seu formulário. Nas propriedades dele vá no envento No Atual e digite o código abaixo:

Private Sub Form_Current()

If Me.link <> nil Then

Me.Imagem.Visible = True

Me.Imagem.Picture = Me.link

Else

Me.Imagem.Visible = False

End If

End Sub

[MrMALJ]

Isso é uma dúvida ou é uma dica?

se for dúvida dá uma olhada no tópico

http://scriptbrasil.com.br/forum/index.php?showtopic=106775

[BRUCCE]

Bom dia MrMajl!

Na verdade é uma dúvida, desculpe-me a enrolada que eu dei, por ter postado como se faz...

Havia visto o Post que você havia feito,

Quero que ao invés do usuário digitar o endereço da foto, quero que ele click em um botão e através de uma "Caixa de Dialogo" ele procuro a foto no Computador e este salve o caminho dela num campo....

Até tenho o código pra isso, mas quando clico no botão, da um erro....

Minha dúvida é quanto ao erro que aparece quando clico no botão...

Valeu!

[MrMALJ]

Talvez o link abaixo lhe ajude

http://office.microsoft.com/en-us/template...=CT011366681033

ou a BrowseFolder (abaixo) que encontrei onde você pode usar para abrir uma caixa de diálogo onde o usuário seleciona a pasta:

API: BrowseFolder Dialog

Author(s)

Terry Kreft

(Q) Ok, I know how to use the GetOpenFileName api, but I want to just retrieve the Directory name. How do I call the Browse for Folder window from code?

(A) Paste the following code in a new module. Save the module with any name. Use the following example as an illustration on how to call the function.

Dim strFolderName as string

strFolderName = BrowseFolder("What Folder you want to select?")

Stephen Lebans has added functionality to open the browse folder at a specific place.

'************** Code Start **************

'This code was originally written by Terry Kreft.

'It is not to be altered or distributed,

'except as part of an application.

'You are free to use it in any application,

'provided the copyright notice is left unchanged.

'

'Code courtesy of

'Terry Kreft

Private Type BROWSEINFO

hOwner As Long

pidlRoot As Long

pszDisplayName As String

lpszTitle As String

ulFlags As Long

lpfn As Long

lParam As Long

iImage As Long

End Type

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _

"SHGetPathFromIDListA" (ByVal pidl As Long, _

ByVal pszPath As String) As Long

Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias _

"SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) _

As Long

Private Const BIF_RETURNONLYFSDIRS = &H1

Public Function BrowseFolder(szDialogTitle As String) As String

Dim X As Long, bi As BROWSEINFO, dwIList As Long

Dim szPath As String, wPos As Integer

With bi

.hOwner = hWndAccessApp

.lpszTitle = szDialogTitle

.ulFlags = BIF_RETURNONLYFSDIRS

End With

dwIList = SHBrowseForFolder(bi)

szPath = Space$(512)

X = SHGetPathFromIDList(ByVal dwIList, ByVal szPath)

If X Then

wPos = InStr(szPath, Chr(0))

BrowseFolder = Left$(szPath, wPos - 1)

Else

BrowseFolder = vbNullString

End If

End Function

'*********** Code End *****************

Claro devo dizer que não testei nada e se conseguir utilizar agradeço se puder nos passar como fez!

[BRUCCE]

Bom dia Galera!

Vou postar abaixo, um código para carregar imagens no BD, dei uma procurar em alguns fóruns e achei esta, já testei e funciona...

Vamos lá.

1º Crie um Campo com o nome Link em Sua tabela, ponha o Tamanho 255.

2º Crie um Form Baseado na Tabela.

3º Crie Controle de Imagem, apos seleciono qualquer foto..

4º No Modo Desing, defina o nome desse Controle como Imagem

5º Va nas propriedades de Form e no EVENTO NO ATUAL, digite:

Private Sub Form_Current()

If Me.link <> nil Then

Me.Imagem.Visible = True

Me.Imagem.Picture = Me.link

Else

Me.Imagem.Visible = False

End If

End Sub

6º Crie um módulo com o código abaixo: (salve-o como strcaminho)

Option Explicit

Option Compare Database

Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _

"GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Boolean

Declare Function GetSaveFileName Lib "comdlg32.dll" Alias _

"GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Boolean

Type MSA_OPENFILENAME

' Seqüência de filtro usada para os filtros do diálogo Abrir.

' Usa MSA_CriarSeqüênciaDeFiltro() para criar isso.

' Padrão = Todos os Arquivos, *.*

strFiltro As String

' Filtro inicial a exibir.

' Padrão = 1

lngÍndiceFiltro As Long

' Diretório inicial no qual abrir o diálogo.

' Padrão = Diretório de trabalho atual.

strDirInicial As String

' Nome de arquivo inicial com o qual preencher o diálogo.

' Padrão = "".

strArqInicial As String

strTítuloDoDiálogo As String

' Extensão padrão para anexar ao arquivo se o usuário não especificar uma.

' Padrão = Valores do Sistema (Abrir Arquivo, Salvar Arquivo).

strExtensãoPadrão As String

' Sinalizadores (consulte a lista de constantes) a serem usados.

' Padrão = sem sinalizadores.

lngSinalizadores As Long

' Caminho completo do arquivo escolhido. Quando a caixa de diálogo Arquivo

' Abrir é apresentada e o usuário escolhe um arquivo não existente, somente

' o texto da caixa "Nome do arquivo" é retornado.

strCaminhoCompletoRetornado As String

' Nome do arquivo escolhido.

strNomeDeArquivoRetornado As String

' Deslocamento no caminho completo (strCaminhoCompletoRetornado)

' onde o nome do arquivo (strNomeDeArquivoRetornado) começa.

intDeslocamentoDoArquivo As Integer

' Deslocamento no caminho completo (strCaminhoCompletoRetornado)

' onde começa a extensão do arquivo.

intExtensãoDoArquivo As Integer

End Type

Const ALLFILES = "Todos os arquivos"

Type OPENFILENAME

lStructSize As Long

hwndOwner As Long

hInstance As Long

lpstrFilter As String

lpstrCustomFilter As Long

nMaxCustrFilter 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

lCustrData As Long

lpfnHook As Long

lpTemplateName As Long

End Type

Const OFN_ALLOWMULTISELECT = &H200

Const OFN_CREATEPROMPT = &H2000

Const OFN_EXPLORER = &H80000

Const OFN_FILEMUSTEXIST = &H1000

Const OFN_HIDEREADONLY = &H4

Const OFN_NOCHANGEDIR = &H8

Const OFN_NODEREFERENCELINKS = &H100000

Const OFN_NONETWORKBUTTON = &H20000

Const OFN_NOREADONLYRETURN = &H8000

Const OFN_NOVALIDATE = &H100

Const OFN_OVERWRITEPROMPT = &H2

Const OFN_PATHMUSTEXIST = &H800

Const OFN_READONLY = &H1

Const OFN_SHOWHELP = &H10

Function localizarArquivo(strCaminhoDeLocalização) As String

' Exibe a caixa de diálogo Abrir para que o usuário localize o

' banco de dados BdLab. Retorna o caminho completo para o BdLab.

Dim msaof As MSA_OPENFILENAME

' Define opções para a caixa de diálogo.

msaof.strTítuloDoDiálogo = "Selecione o arquivo."

msaof.strDirInicial = strCaminhoDeLocalização

msaof.strFiltro = MSA_CriarSeqüênciaDeFiltro("Todos", "*.*")

' Chama a rotina do diálogo Abrir.

MSA_ObterAbrirNomeArq msaof

' Retorna o caminho e o nome de arquivo.

localizarArquivo = Trim(msaof.strCaminhoCompletoRetornado)

End Function

Function MSA_CriarSeqüênciaDeFiltro(ParamArray varFilt() As Variant) As String

' Cria uma seqüência de filtro a partir dos argumentos passados.

' Retorna "" se nenhum argumento for passado.

' Espera um número par de argumentos (nome do filtro, extensão),

' mas se um número ímpar de argumentos for passado, anexa *.*

Dim strFiltro As String

Dim intRet As Integer

Dim intNúm As Integer

intNúm = UBound(varFilt)

If (intNúm <> -1) Then

For intRet = 0 To intNúm

strFiltro = strFiltro & varFilt(intRet) & vbNullChar

Next

If intNúm Mod 2 = 0 Then

strFiltro = strFiltro & "*.*" & vbNullChar

End If

strFiltro = strFiltro & vbNullChar

Else

strFiltro = ""

End If

MSA_CriarSeqüênciaDeFiltro = strFiltro

End Function

Function MSA_ConverterSeqüênciaDeFiltro(strFiltroEnt As String) As String

' Cria uma seqüência de filtro a partir de uma seqüência separada por barras ("|").

' A seqüência deve consistir em pares filtro|extensão, como "Access Databases|*.mdb|All Files|*.*"

' Se não houver extensões para o último par de filtro, *.* será adicionado.

' Este código ignora quaisquer seqüências vazias, ou seja, pares "||".

' Retorna "" quando a seqüência passada está vazia.

Dim strFiltro As String

Dim intNúm As Integer, intPos As Integer, intÚltPos As Integer

strFiltro = ""

intNúm = 0

intPos = 1

intÚltPos = 1

' Adiciona seqüências enquanto encontra barras.

' Ignora quaisquer seqüências vazias (não admitidas).

Do

intPos = InStr(intÚltPos, strFiltroEnt, "|")

If (intPos > intÚltPos) Then

strFiltro = strFiltro & Mid(strFiltroEnt, intÚltPos, intPos - intÚltPos) & vbNullChar

intNúm = intNúm + 1

intÚltPos = intPos + 1

ElseIf (intPos = intÚltPos) Then

intÚltPos = intPos + 1

End If

Loop Until (intPos = 0)

' Obtém a última seqüência se ela existir (assumindo

' que strFiltroEnt não termina em barra).

intPos = Len(strFiltroEnt)

If (intPos >= intÚltPos) Then

strFiltro = strFiltro & Mid(strFiltroEnt, intÚltPos, intPos - intÚltPos + 1) & vbNullChar

intNúm = intNúm + 1

End If

' Adiciona *.* se não houver extensão para a última seqüência.

If intNúm Mod 2 = 1 Then

strFiltro = strFiltro & "*.*" & vbNullChar

End If

' Adiciona NULL de terminação se temos algum filtro.

If strFiltro <> "" Then

strFiltro = strFiltro & vbNullChar

End If

MSA_ConverterSeqüênciaDeFiltro = strFiltro

End Function

Private Function MSA_ObterSalvarNomeArq(msaof As MSA_OPENFILENAME) As Integer

' Abre o diálogo de salvar arquivo.

Dim of As OPENFILENAME

Dim intRet As Integer

MSAOF_para_OF msaof, of

of.flags = of.flags Or OFN_HIDEREADONLY

intRet = GetSaveFileName(of)

If intRet Then

OF_para_MSAOF of, msaof

End If

MSA_ObterSalvarNomeArq = intRet

End Function

Function MSA_SimplesObterSalvarNomeArq() As String

' Abre o diálogo de salvar arquivo com valores padrões.

Dim msaof As MSA_OPENFILENAME

Dim intRet As Integer

Dim strRet As String

intRet = MSA_ObterSalvarNomeArq(msaof)

If intRet Then

strRet = msaof.strCaminhoCompletoRetornado

End If

MSA_SimplesObterSalvarNomeArq = strRet

End Function

Private Function MSA_ObterAbrirNomeArq(msaof As MSA_OPENFILENAME) As Integer

' Abre o diálogo Abrir.

Dim of As OPENFILENAME

Dim intRet As Integer

MSAOF_para_OF msaof, of

intRet = GetOpenFileName(of)

If intRet Then

OF_para_MSAOF of, msaof

End If

MSA_ObterAbrirNomeArq = intRet

End Function

Function MSA_SimplesObterAbrirNomeArq() As String

' Abre o diálogo Abrir com valores padrões.

Dim msaof As MSA_OPENFILENAME

Dim intRet As Integer

Dim strRet As String

intRet = MSA_ObterAbrirNomeArq(msaof)

If intRet Then

strRet = msaof.strCaminhoCompletoRetornado

End If

MSA_SimplesObterAbrirNomeArq = strRet

End Function

Private Sub OF_para_MSAOF(of As OPENFILENAME, msaof As MSA_OPENFILENAME)

' Esta sub converte da estrutura Win32 para a estrutura do Microsoft Access.

msaof.strCaminhoCompletoRetornado = Left(of.lpstrFile, InStr(of.lpstrFile, vbNullChar) - 1)

msaof.strNomeDeArquivoRetornado = of.lpstrFileTitle

msaof.intDeslocamentoDoArquivo = of.nFileOffset

msaof.intExtensãoDoArquivo = of.nFileExtension

End Sub

Private Sub MSAOF_para_OF(msaof As MSA_OPENFILENAME, of As OPENFILENAME)

' Esta sub converte da estrutura do Microsoft Access para a estrutura Win32.

Dim strArquivo As String * 512

' Inicializa algumas partes da estrutura.

of.hwndOwner = Application.hWndAccessApp

of.hInstance = 0

of.lpstrCustomFilter = 0

of.nMaxCustrFilter = 0

of.lpfnHook = 0

of.lpTemplateName = 0

of.lCustrData = 0

If msaof.strFiltro = "" Then

of.lpstrFilter = MSA_CriarSeqüênciaDeFiltro(ALLFILES)

Else

of.lpstrFilter = msaof.strFiltro

End If

of.nFilterIndex = msaof.lngÍndiceFiltro

of.lpstrFile = msaof.strArqInicial _

& String(512 - Len(msaof.strArqInicial), 0)

of.nMaxFile = 511

of.lpstrFileTitle = String(512, 0)

of.nMaxFileTitle = 511

of.lpstrTitle = msaof.strTítuloDoDiálogo

of.lpstrInitialDir = msaof.strDirInicial

of.lpstrDefExt = msaof.strExtensãoPadrão

of.flags = msaof.lngSinalizadores

of.lStructSize = Len(of)

End Sub

7º No Form em modo Desing, crie um Botão de Comando, e no EVENTO AO CLICAR, coloque o código abaixo:

Dim strCaminho As String

strCaminho = localizarArquivo("c:\")

If IsNull(strCaminho) Or strCaminho = "" Then Exit Sub

Link = strCaminho

Lembrando que a Imagem não é carregado de imediato, após seleciona-la, navegue entre algum registro p/ que ela apareça...

Espero ter ajudado..

Abçs!

beleza Pessoal, já resolvei quase todo o meu probelma....

Preciso saber, como posso fazer para criar um botão que apague(limpar) as informações de um campo especifico em um determinado registro??

Valeu..