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


    [Resolvido]Consulta cliente pelo subformulario

    avatar
    cicero de assis
    Novato
    Novato

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 33
    Registrado : 02/04/2019

    [Resolvido]Consulta cliente pelo subformulario Empty [Resolvido]Consulta cliente pelo subformulario

    Mensagem  cicero de assis Seg 30 Nov 2020, 2:33 pm

    Bom dia a todo do forum, Estou tendo dificuldade em em um sub formulario. Nao estou conseguindo exibir fotos por cliente individual no subformulario

    segue o link do bd.



    www.dropbox.com/s/0rcbosb2y95ehwr/Database4.accdb?dl=0
    ANTONILDO CORDEIRO
    ANTONILDO CORDEIRO
    Novato
    Novato

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 24
    Registrado : 02/04/2019

    [Resolvido]Consulta cliente pelo subformulario Empty Re: [Resolvido]Consulta cliente pelo subformulario

    Mensagem  ANTONILDO CORDEIRO Seg 30 Nov 2020, 4:35 pm

    Boa tarde, Cicero!!!
    experimente usar este codigo no seu formulario espero ajudar


    Dim path As String


    Private Sub Form_RecordExit(Cancel As Integer)
    ' Ocultar o rótulo da mensagem de erro para reduzir
    ' a intermitência durante a navegação entre os registros.
    ErrorMsg.Visible = False
    End Sub

    Private Sub AddPicture_Click()
    ' Usar a caixa de diálogo Abrir arquivo a fim de escolher
    ' um nome de arquivo para a foto do funcionário.
    getFileName
    End Sub

    Private Sub RemovePicture_Click()
    ' Remover o nome do arquivo do registro do funcionário e
    ' exibir o rótulo da mensagem de erro.
    Me![ImagePath] = ""
    hideImageFrame
    ErrorMsg.Visible = True
    End Sub

    Private Sub Form_AfterUpdate()
    ' Consultar novamente a caixa de combinação Supervisor depois que um
    ' registro for alterado. Em seguida, mostrar o rótulo da mensagem de erro
    ' se não houver um nome de arquivo para o registro de funcionário ou
    ' exibir a imagem se existir um nome de arquivo.
    On Error Resume Next
    showErrorMessage
    showImageFrame
    If (IsRelative(Me!ImagePath) = True) Then
    Me![ImageFrame].Picture = path & Me![ImagePath]
    Else
    Me![ImageFrame].Picture = Me![ImagePath]
    End If
    End Sub

    Private Sub ImagePath_AfterUpdate()
    ' Depois de selecionar uma imagem de funcionário, exiba-a.
    On Error Resume Next
    showErrorMessage
    showImageFrame
    If (IsRelative(Me!ImagePath) = True) Then
    Me![ImageFrame].Picture = path & Me![ImagePath]
    Else
    Me![ImageFrame].Picture = Me![ImagePath]
    End If
    End Sub
    Private Sub Form_Current()
    ' Exiba a foto do registro de funcionário atual se a imagem
    ' existir. Se o nome de arquivo não existir mais ou estiver
    ' em branco para o funcionário atual, defina a legenda do rótulo
    ' da mensagem de erro com a mensagem apropriada.
    Dim res As Boolean
    Dim fName As String

    path = CurrentProject.path
    On Error Resume Next
    ErrorMsg.Visible = False
    If Not IsNull(Me![FOTO]) Then
    res = IsRelative(Me![FOTO])
    fName = Me![ImagePath]
    If (res = True) Then
    fName = path & "\" & fName
    End If

    Me![ImageFrame].Picture = fName
    showImageFrame
    Me.PaintPalette = Me![ImageFrame].ObjectPalette
    If (Me![ImageFrame].Picture <> fName) Then
    hideImageFrame
    ErrorMsg.Caption = "Foto não encontrada"
    ErrorMsg.Visible = True
    End If
    Else
    hideImageFrame
    ErrorMsg.Caption = "Clique em 'Adicionar/alterar' para adicionar uma foto 65x63"
    ErrorMsg.Visible = True
    End If

    End Sub

    Sub getFileName()
    ' Exibe a caixa de diálogo Abrir arquivo a fim de escolher um nome
    ' de arquivo para o registro de funcionário atual. Se o usuário
    ' selecionar um arquivo, essa função exibe-o no controle de imagem.
    Dim fileName As String
    Dim result As Integer
    With Application.FileDialog(msoFileDialogFilePicker)
    .Title = "Selecionar foto"
    .Filters.Add "Todos os arquivos", "*.*"
    .Filters.Add "JPEGs", "*.jpg"
    .Filters.Add "Bitmaps", "*.bmp"
    .Filters.Add "Pngs", "*.png"
    .FilterIndex = 4
    .AllowMultiSelect = False
    .InitialFileName = CurrentProject.path
    result = .Show
    If (result <> 0) Then
    fileName = Trim(.SelectedItems.Item(1))
    Me![ImagePath].Visible = True
    Me![ImagePath].SetFocus
    Me![ImagePath].Text = fileName
    Me![CODIGO].SetFocus
    Me![ImagePath].Visible = False
    End If
    End With
    End Sub

    Sub showErrorMessage()
    ' Exibir o rótulo da mensagem de erro se o arquivo de imagem não estiver disponível.
    If Not IsNull(Me![FOTO]) Then
    ErrorMsg.Visible = False
    Else
    ErrorMsg.Visible = True
    End If
    End Sub

    Function IsRelative(fName As String) As Boolean
    ' Retorna False se o nome de arquivo contiver uma unidade ou caminho UNC
    IsRelative = (InStr(1, fName, ":") = 0) And (InStr(1, fName, "\\") = 0)
    End Function

    Sub hideImageFrame()
    ' Ocultar o controle de imagem
    Me![ImageFrame].Visible = False
    End Sub

    Sub showImageFrame()
    ' Exibir o controle de imagem
    Me![ImageFrame].Visible = True
    End Sub

    avatar
    cicero de assis
    Novato
    Novato

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 33
    Registrado : 02/04/2019

    [Resolvido]Consulta cliente pelo subformulario Empty Re: [Resolvido]Consulta cliente pelo subformulario

    Mensagem  cicero de assis Seg 30 Nov 2020, 5:04 pm

    meu amigo boa tarde,  voce viu o exemplo do banco de dados que passei, eu pergunto porque eu ja usei um codigo semelhante a esse que voce passou e nao deu certo
    ANTONILDO CORDEIRO
    ANTONILDO CORDEIRO
    Novato
    Novato

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 24
    Registrado : 02/04/2019

    [Resolvido]Consulta cliente pelo subformulario Empty Re: [Resolvido]Consulta cliente pelo subformulario

    Mensagem  ANTONILDO CORDEIRO Seg 30 Nov 2020, 5:08 pm

    eu vi sim, estou vendo que vc adaptou para a sua realidade.
    vc já experimentou colocar o no campo LocalFoto como fonte de controle o campo foto ?
    avatar
    cicero de assis
    Novato
    Novato

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 33
    Registrado : 02/04/2019

    [Resolvido]Consulta cliente pelo subformulario Empty Re: [Resolvido]Consulta cliente pelo subformulario

    Mensagem  cicero de assis Seg 30 Nov 2020, 5:37 pm

    meu amigo deu certo, agora quando não tem foto ele simplesmente coloca qualquer foto ao invés de mostra foto indisponível
    ANTONILDO CORDEIRO
    ANTONILDO CORDEIRO
    Novato
    Novato

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 24
    Registrado : 02/04/2019

    [Resolvido]Consulta cliente pelo subformulario Empty Re: [Resolvido]Consulta cliente pelo subformulario

    Mensagem  ANTONILDO CORDEIRO Seg 30 Nov 2020, 6:47 pm

    mas Cicero foi deve informa se nao tiver foto ele exibir o arquivo nemhumafoto.bmp que tambem deve ser salvo na mesa pasta das fotos

    entendeu?
    avatar
    cicero de assis
    Novato
    Novato

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 33
    Registrado : 02/04/2019

    [Resolvido]Consulta cliente pelo subformulario Empty Re: [Resolvido]Consulta cliente pelo subformulario

    Mensagem  cicero de assis Sex 11 Dez 2020, 4:15 pm

    Resolvido meu amigo, obrigado

    Conteúdo patrocinado

    [Resolvido]Consulta cliente pelo subformulario Empty Re: [Resolvido]Consulta cliente pelo subformulario

    Mensagem  Conteúdo patrocinado


      Data/hora atual: Qui 13 Maio 2021, 9:10 am