Ir para conteúdo
Fórum Script Brasil
  • 0

Puxar imagem no banco de dados para pesquisar e editar

Ana.Paula

Perguntado por Ana.Paula,

 Share

Pergunta

Ana.Paula

Ana.Paula

Postado
Postado (editado)

Olá pessoal alguém pode me ajudar, estou fazendo um programa no VBA, e não consigo colocar uma programação para puxar a imagem que salvei na planilha do Excel, coloco Novo digito o código do produto, os dados, insiro a foto e ok salva, porém quando pesquiso o código do produto que acabei de salvar, não consigo uma programação para puxar a imagem junto com os dados salvos, fazendo-a aparecer em pesquisa e quando eu edito um registro que salvei, alguém pode me ajudar?

 

Dim Selecao As String
Public beditar As Boolean

Private Sub bloqpesq_Click()

End Sub

Private Sub botpesq2_Click()
Dim iLin As Long

iLin = cmbdescricao.ListIndex + 2

If iLin > 1 Then

fDados_PCP iLin
'habilitar botãoeditar


buttoneditar.Enabled = True

buttonexcluir.Enabled = True
buttonnovo.Enabled = True

End If

buttonexcluir.Enabled = False
buttoneditar.Enabled = False
buttonnovo.Enabled = False

End Sub

Private Sub buttongravar_Click()

Dim iLin As Long

If beditar = True Then
'Quando estou editando um registro
    iLin = cmbcodigo.ListIndex + 2
Else
    If fProcura_Cod(txtboxcodigoprod.Value) = True Then
        MsgBox ("Código já cadastrado!")
        Exit Sub
    End If
    iLin = Range("A1048500").End(xlUp).Row + 1


    If IsNumeric(Cells(iLin - 1, "A").Value) Then
        Cells(iLin, "A").Value = Cells(iLin - 1, "A").Value + 1 ' codigo
    Else
        Cells(iLin, "A").Value = 1
    End If
End If

    If (txtboxcodigoprod.Text = "") Then
        MsgBox ("Digitar um Código Valido!")
        Exit Sub
    Else
        Cells(iLin, "B").Value = txtboxcodigoprod.Text
    End If
    If txtboxdescricao.Text = "" Then
        MsgBox ("Digite a Descrição!")
        Exit Sub
    Else
        Cells(iLin, "C").Value = txtboxdescricao.Text
    End If
    
    If txtboxex1.Text = "" Then
        MsgBox ("Digite o Item 1!")
        Exit Sub
    Else
        Cells(iLin, "D").Value = txtboxex1.Text
      End If
        
  If txtboxex2.Text = "" Then
        MsgBox ("Digite o Item 2!")
        Exit Sub
    Else
        Cells(iLin, "E").Value = txtboxex2.Text
    End If
        
        
       
    
    ' Para esses items se quiser que sejam obrigatórios repetir o mesmo procedimento!
    Cells(iLin, "E").Value = txtboxex2.Text
    Cells(iLin, "F").Value = txtboxex3.Text
    Cells(iLin, "G").Value = txtboxex4.Text
    Cells(iLin, "H").Value = txtboxex5.Text
    Cells(iLin, "I").Value = txtboxex6.Text
    Cells(iLin, "J").Value = txtboxex7.Text
    Cells(iLin, "K").Value = txtboxex8.Text
    Cells(iLin, "L").Value = txtboxex9.Text
    Cells(iLin, "M").Value = txtboxex10.Text
    Cells(iLin, "N").Value = txtboxvari1.Text
    Cells(iLin, "O").Value = txtboxvari2.Text
    Cells(iLin, "P").Value = txtboxvari3.Text
    Cells(iLin, "Q").Value = txtboxvari4.Text
    Cells(iLin, "R").Value = txtboxvari5.Text
    Cells(iLin, "S").Value = txtboxvari6.Text
    Cells(iLin, "T").Value = Selecao

    Flimpadados

    MsgBox "Código gravado com sucesso!"
    
    


End Sub
Function fProcura_Cod(sCodigo As String) As Boolean
Dim bFind As Boolean
bFind = False
With Worksheets("PCP").Range("B1:B60000")

    Set c = .Find(sCodigo, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
    If Not c Is Nothing Then
        firstAddress = c.Address
        Do
            If c.Value = sCodigo Then
                bFind = True
                fProcura_Cod = bFind
                Exit Function
            End If
            Set c = .FindNext(c)
        Loop While Not c Is Nothing
    End If
End With

End Function

Private Sub buttonexcluir_Click()

Dim iLin As Long
iLin = cmbcodigo.ListIndex + 2

If iLin > 1 Then

If MsgBox("Deseja realmente excluir o produto?", vbYesNo) = vbYes Then

    Range("A" & iLin).EntireRow.Delete
    
End If
    
End If

  Flimpadados


cmbdescricao.Enabled = False
botpesq2.Enabled = False


    

End Sub
Private Sub buttoneditar_Click()

    
    
buttonnovo.Enabled = False


Frame1.Enabled = True
Frame1.BackColor = vbCyan
beditar = True

Frame1.BackColor = vbCyan
Label1.BackColor = vbCyan
Label2.BackColor = vbCyan
Label3.BackColor = vbCyan
Label4.BackColor = vbCyan
Label5.BackColor = vbCyan
Label6.BackColor = vbCyan
Label7.BackColor = vbCyan
Label8.BackColor = vbCyan
Label9.BackColor = vbCyan
Label10.BackColor = vbCyan
Label11.BackColor = vbCyan
Label12.BackColor = vbCyan
Label13.BackColor = vbCyan
Label14.BackColor = vbCyan
Label15.BackColor = vbCyan
Label16.BackColor = vbCyan
Label17.BackColor = vbCyan
Label18.BackColor = vbCyan
Label19.BackColor = vbCyan
Label20.BackColor = vbCyan
Label23.BackColor = vbCyan


End Sub

Private Sub buttonlimpar_Click()


buttoneditar.Enabled = True
buttonnovo.Enabled = True
beditar = False
buttongravar.Enabled = False
cmbcodigo.Value = ""
txtposicao.Value = ""
txtboxcodigoprod.Value = ""
txtboxdescricao.Value = ""
txtboxex1.Value = ""
txtboxex2.Value = ""
txtboxex3.Value = ""
txtboxex4.Value = ""
txtboxex5.Value = ""
txtboxex6.Value = ""
txtboxex7.Value = ""
txtboxex8.Value = ""
txtboxex9.Value = ""
txtboxex10.Value = ""
txtboxvari1.Value = ""
txtboxvari2.Value = ""
txtboxvari3.Value = ""
txtboxvari4.Value = ""
txtboxvari5.Value = ""
txtboxvari6.Value = ""
cmbdescricao.Value = ""
frmPrincipal.Image1.Picture = LoadPicture()

Frame1.BackColor = -2147483633
Label1.BackColor = -2147483633
Label2.BackColor = -2147483633
Label3.BackColor = -2147483633
Label4.BackColor = -2147483633
Label5.BackColor = -2147483633
Label6.BackColor = -2147483633
Label7.BackColor = -2147483633
Label8.BackColor = -2147483633
Label9.BackColor = -2147483633
Label10.BackColor = -2147483633
Label11.BackColor = -2147483633
Label12.BackColor = -2147483633
Label13.BackColor = -2147483633
Label14.BackColor = -2147483633
Label15.BackColor = -2147483633
Label16.BackColor = -2147483633
Label17.BackColor = -2147483633
Label18.BackColor = -2147483633
Label19.BackColor = -2147483633
Label20.BackColor = -2147483633
Label23.BackColor = -2147483633
beditar = False


End Sub

Private Sub buttonnovo_Click()

Frame1.Enabled = True
frmPrincipal.cmdimagem.Enabled = True
buttongravar.Enabled = True

Frame1.BackColor = vbWhite
Label1.BackColor = vbWhite
Label2.BackColor = vbWhite
Label3.BackColor = vbWhite
Label4.BackColor = vbWhite
Label5.BackColor = vbWhite
Label6.BackColor = vbWhite
Label7.BackColor = vbWhite
Label8.BackColor = vbWhite
Label9.BackColor = vbWhite
Label10.BackColor = vbWhite
Label11.BackColor = vbWhite
Label12.BackColor = vbWhite
Label13.BackColor = vbWhite
Label14.BackColor = vbWhite
Label15.BackColor = vbWhite
Label16.BackColor = vbWhite
Label17.BackColor = vbWhite
Label18.BackColor = vbWhite
Label19.BackColor = vbWhite
Label20.BackColor = vbWhite
Label23.BackColor = vbWhite

buttonnovo.SetFocus
beditar = False
cmbcodigo.Value = ""

frmPrincipal.cmdimagem.Enabled = True

End Sub

Private Sub buttonpesq_Click()

Dim iLin As Long


iLin = cmbcodigo.ListIndex + 2

If iLin > 1 Then

fDados_PCP iLin
'habilitar botãoeditar


buttoneditar.Enabled = True

buttonexcluir.Enabled = True
buttonnovo.Enabled = True
buttongravar.Enabled = True
cmbdescricao.Value = ""

End If


End Sub

Private Sub CheckBox1_Click()


If CheckBox1.Value = True Then cmbdescricao.Enabled = True
If CheckBox1.Value = False Then cmbdescricao.Enabled = False
If CheckBox1.Value = True Then botpesq2.Enabled = True
If CheckBox1.Value = False Then botpesq2.Enabled = False
If CheckBox1.Value = True Then cmbcodigo.Enabled = False
If CheckBox1.Value = True Then buttonpesq.Enabled = False
If CheckBox1.Value = False Then cmbcodigo.Enabled = True
If CheckBox1.Value = False Then buttonpesq.Enabled = True


cmbcodigo.Value = ""
cmbcodigo.Value = ""
txtposicao.Value = ""
txtboxcodigoprod.Value = ""
txtboxdescricao.Value = ""
txtboxex1.Value = ""
txtboxex2.Value = ""
txtboxex3.Value = ""
txtboxex4.Value = ""
txtboxex5.Value = ""
txtboxex6.Value = ""
txtboxex7.Value = ""
txtboxex8.Value = ""
txtboxex9.Value = ""
txtboxex10.Value = ""
txtboxvari1.Value = ""
txtboxvari2.Value = ""
txtboxvari3.Value = ""
txtboxvari4.Value = ""
txtboxvari5.Value = ""
txtboxvari6.Value = ""
frmPrincipal.Image1.Picture = LoadPicture()

End Sub

Private Sub cmbcodigo_Change()

cmbdescricao.Value = ""

End Sub

Private Sub cmbdescricao_Change()
buttonexcluir.Enabled = False
buttoneditar.Enabled = False
buttongravar.Enabled = False
buttonnovo.Enabled = False
End Sub

Private Sub cmdimagem_Click()

Dim Figura As Office.FileDialog

Set Figura = Application.FileDialog(msoFileDialogFilePicker)

With Figura

AllowMultiSelect = False
Title = "Selecione a imagem."
.Filters.Add "imagem JPG", "*.jpg *"

If Figura.Show = True Then
Selecao = Figura.SelectedItems.Item(1)
frmPrincipal.Image1.Picture = LoadPicture(Selecao)

End If

End With


End Sub

Private Sub CommandButton7_Click()

Application.Visible = False

End Sub

Private Sub CommandButton8_Click()

Application.Visible = True

End Sub

Private Sub SubabreUserForm1()

UserForm1.Show

End Sub


Private Sub Frame1_Click()

End Sub

Private Sub UserForm_Initialize()
buttongravar.Enabled = False
cmbcodigo.SetFocus
Application.Visible = False

fCarrega_Cmbcodigo
fCarrega_Cmbdescricao

End Sub
Function Flimpadados()

txtposicao.Value = ""
txtboxcodigoprod.Value = ""
txtboxdescricao.Value = ""
txtboxex1.Value = ""
txtboxex2.Value = ""
txtboxex3.Value = ""
txtboxex4.Value = ""
txtboxex5.Value = ""
txtboxex6.Value = ""
txtboxex7.Value = ""
txtboxex8.Value = ""
txtboxex9.Value = ""
txtboxex10.Value = ""
txtboxvari1.Value = ""
txtboxvari2.Value = ""
txtboxvari3.Value = ""
txtboxvari4.Value = ""
txtboxvari5.Value = ""
txtboxvari6.Value = ""
frmPrincipal.Image1.Picture = LoadPicture()


fCarrega_Cmbcodigo
fCarrega_Cmbdescricao

Frame1.BackColor = -2147483633
Frame1.BackColor = -2147483633
Label1.BackColor = -2147483633
Label2.BackColor = -2147483633
Label3.BackColor = -2147483633
Label4.BackColor = -2147483633
Label5.BackColor = -2147483633
Label6.BackColor = -2147483633
Label7.BackColor = -2147483633
Label8.BackColor = -2147483633
Label9.BackColor = -2147483633
Label10.BackColor = -2147483633
Label11.BackColor = -2147483633
Label12.BackColor = -2147483633
Label13.BackColor = -2147483633
Label14.BackColor = -2147483633
Label15.BackColor = -2147483633
Label16.BackColor = -2147483633
Label17.BackColor = -2147483633
Label18.BackColor = -2147483633
Label19.BackColor = -2147483633
Label20.BackColor = -2147483633
Label23.BackColor = -2147483633

Frame1.Enabled = False
buttoneditar.Enabled = False
buttonexcluir.Enabled = False

End Function

Function fCarrega_Cmbcodigo()


Dim iLin As Long

iLin = 2

'limpa combobox
cmbcodigo.Clear

'carrega cmbcodigo

While Cells(iLin, "A").Text <> ""
cmbcodigo.AddItem Cells(iLin, "B").Text
iLin = iLin + 1

Wend

End Function

Function fDados_PCP(iLinha As Long)

'Carrega dados

txtposicao.Value = Cells(iLinha, "A").Text
txtboxcodigoprod.Value = Cells(iLinha, "B").Text
txtboxdescricao.Value = Cells(iLinha, "C").Text
txtboxex1.Value = Cells(iLinha, "D").Text
txtboxex2.Value = Cells(iLinha, "E").Text
txtboxex3.Value = Cells(iLinha, "F").Text
txtboxex4.Value = Cells(iLinha, "G").Text
txtboxex5.Value = Cells(iLinha, "H").Text
txtboxex6.Value = Cells(iLinha, "I").Text
txtboxex7.Value = Cells(iLinha, "J").Text
txtboxex8.Value = Cells(iLinha, "K").Text
txtboxex9.Value = Cells(iLinha, "L").Text
txtboxex10.Value = Cells(iLinha, "M").Text
txtboxvari1.Value = Cells(iLinha, "N").Text
txtboxvari2.Value = Cells(iLinha, "O").Text
txtboxvari3.Value = Cells(iLinha, "P").Text
txtboxvari4.Value = Cells(iLinha, "Q").Text
txtboxvari5.Value = Cells(iLinha, "R").Text
txtboxvari6.Value = Cells(iLinha, "S").Text

End Function

Function fCarrega_Cmbdescricao()


Dim iLin As Long

iLin = 2

'limpa combobox
cmbdescricao.Clear

'carrega cmbcodigo

While Cells(iLin, "A").Text <> ""
cmbdescricao.AddItem Cells(iLin, "C").Text
iLin = iLin + 1

Wend


End Function

 

Sem título 2.png

Editado por Ana.Paula
Link para o comentário
Compartilhar em outros sites

6 respostass a esta questão

Posts Recomendados

  • 0
Alyson Ronnan Martins

Alyson Ronnan Martins

Postado
Postado

Eu mudei uma coisa no seu código de puxar a foto. 

Private Sub cmdimagem_Click()

Dim Figura As Office.FileDialog

Set Figura = Application.FileDialog(msoFileDialogFilePicker)

With Figura

AllowMultiSelect = False
Title = "Selecione a imagem."
.Filters.Add "imagem JPG", "*.jpg *"

If Figura.Show = True Then
Selecao = Figura.SelectedItems.Item(1)
frmPrincipal.Image1.Picture = LoadPicture(Selecao)

End If

End With


End Sub

Esse é a alteração. 

Private Sub cmdimagem_Click()
Dim Figura As Office.FileDialog
Set Figura = Application.FileDialog(msoFileDialogFilePicker)
With Figura
	'Aqui ponto antes dos comandos
    '-----------------------------
	.AllowMultiSelect = False
	.Title = "Selecione a imagem."
    '----------------
    'Fim da alteração
    
	.Filters.Add "imagem JPG", "*.jpg *"

	If Figura.Show = True Then
		Selecao = Figura.SelectedItems.Item(1)
		frmPrincipal.Image1.Picture = LoadPicture(Selecao)
	End If
End With

 

Link para o comentário
Compartilhar em outros sites
  • 0
Ana.Paula

Ana.Paula

Postado
  • Autor
Postado

Muito Obrigada Alyson Ronnan Martins, mas ele está salvando tudo certo nessa parte, ele puxa a imagem no sistema salva na planilha, o problema é que eu gostaria de um comando para puxar as imagens que foram salvas na planilha quando clicasse em pesquisar, elas não voltam, tentei vários mais nada funcionou. Então quando pesquiso um código a imagem que salvei não aparece.

Link para o comentário
Compartilhar em outros sites
  • 0
Ana.Paula

Ana.Paula

Postado
  • Autor
Postado

 Alyson Ronnan Martins, o programa está salvando o caminho da imagem na planilha, preciso  que a pesquisa puxe o caminho salvo na Planilha PCP, coluna T iniciando da linha 2, e retorne a imagem que foi salva. Vou enviar o codigo da Sub Pesquisar, mas não tenho nada nela ainda....Exemplo: Tenho o botão Novo, Gravar e Pesquisar. Quando clico em Novo insiro dados e uma imagem de um produto isso está tudo ok, em Gravar, gravo os dados que inseri e a imagem esta ok também. Porem quando clico no código do produto que inseri anteriormente e em pesquisar, somente a  imagem não vem, os dados estão normais, eles aparecem.   A Sub buttonpesq tem que chamar a imagem que teve o caminho salvo na planilha.

 

Private Sub buttonpesq_Click()


Dim iLin As Long


iLin = cmbcodigo.ListIndex + 2

If iLin > 1 Then

fDados_PCP iLin
'habilitar botãoeditar


buttoneditar.Enabled = True

buttonexcluir.Enabled = True
buttonnovo.Enabled = True
buttongravar.Enabled = True
cmbdescricao.Value = ""

End If


End Sub

Link para o comentário
Compartilhar em outros sites
  • 0
Alyson Ronnan Martins

Alyson Ronnan Martins

Postado
Postado

Boa noite. @Ana.Paula

Supondo que tenha entendi tudo esse comando pesquisar executa seguinte linha: 

fDados_PCP iLin

Sendo o comando responsável por trazer as imagens imagens.
Olhando esse comando não vi comando para carregar a imagem, somente os textos, por isso não aparece foto quando você faz a pesquisa: 

Function fDados_PCP(iLinha As Long)

'Carrega dados

txtposicao.Value = Cells(iLinha, "A").Text
txtboxcodigoprod.Value = Cells(iLinha, "B").Text
txtboxdescricao.Value = Cells(iLinha, "C").Text
txtboxex1.Value = Cells(iLinha, "D").Text
txtboxex2.Value = Cells(iLinha, "E").Text
txtboxex3.Value = Cells(iLinha, "F").Text
txtboxex4.Value = Cells(iLinha, "G").Text
txtboxex5.Value = Cells(iLinha, "H").Text
txtboxex6.Value = Cells(iLinha, "I").Text
txtboxex7.Value = Cells(iLinha, "J").Text
txtboxex8.Value = Cells(iLinha, "K").Text
txtboxex9.Value = Cells(iLinha, "L").Text
txtboxex10.Value = Cells(iLinha, "M").Text
txtboxvari1.Value = Cells(iLinha, "N").Text
txtboxvari2.Value = Cells(iLinha, "O").Text
txtboxvari3.Value = Cells(iLinha, "P").Text
txtboxvari4.Value = Cells(iLinha, "Q").Text
txtboxvari5.Value = Cells(iLinha, "R").Text
txtboxvari6.Value = Cells(iLinha, "S").Text

End Function

Como você informou que o endereço responsável pela foto estava na coluna "T" e esse comando acima não carrega essa coluna, presumo que seu código falta o "LoadPicture" na coluna "T" 

frmPrincipal.Image1.Picture = LoadPicture(Cells(iLinha, "T").Text)

Ficando no final assim: 

Function fDados_PCP(iLinha As Long)

'Carrega dados

txtposicao.Value = Cells(iLinha, "A").Text
txtboxcodigoprod.Value = Cells(iLinha, "B").Text
txtboxdescricao.Value = Cells(iLinha, "C").Text
txtboxex1.Value = Cells(iLinha, "D").Text
txtboxex2.Value = Cells(iLinha, "E").Text
txtboxex3.Value = Cells(iLinha, "F").Text
txtboxex4.Value = Cells(iLinha, "G").Text
txtboxex5.Value = Cells(iLinha, "H").Text
txtboxex6.Value = Cells(iLinha, "I").Text
txtboxex7.Value = Cells(iLinha, "J").Text
txtboxex8.Value = Cells(iLinha, "K").Text
txtboxex9.Value = Cells(iLinha, "L").Text
txtboxex10.Value = Cells(iLinha, "M").Text
txtboxvari1.Value = Cells(iLinha, "N").Text
txtboxvari2.Value = Cells(iLinha, "O").Text
txtboxvari3.Value = Cells(iLinha, "P").Text
txtboxvari4.Value = Cells(iLinha, "Q").Text
txtboxvari5.Value = Cells(iLinha, "R").Text
txtboxvari6.Value = Cells(iLinha, "S").Text

'Carregar imagem
frmPrincipal.Image1.Picture = LoadPicture(Cells(iLinha, "T").Text)

End Function

Olha como ficou o código com a alteração nessa 

Link para o comentário
Compartilhar em outros sites
  • 0
Ana.Paula

Ana.Paula

Postado
  • Autor
Postado

Alyson Ronnan Martins era isso mesmo muito obrigada, eu sabia que era bem simples mais eu não conseguia fazer, fiz o mesmo comando mais me esqueci da function, isso vai ser muito importante para conseguir um trabalho que estou estagiando e desenvolvendo o programa como melhoria, pude perceber esse problema e só um software simples solucionava, sou entusiasta do VBA nunca estudei programação, já fiz alguns programas até mais complexos mais nunca com imagem e comecei a tentar,  agradeço muito a você e se tudo der certo saiba que sua ajuda foi parte de ter conseguido...outra ver muito obrigada, abraço

Link para o comentário
Compartilhar em outros sites

Participe da discussão

Você pode postar agora e se registrar depois. Se você já tem uma conta, acesse agora para postar com sua conta.

Visitante
Responder esta pergunta...

×   Você colou conteúdo com formatação.   Remover formatação

  Apenas 75 emoticons são permitidos.

×   Seu link foi incorporado automaticamente.   Exibir como um link em vez disso

×   Seu conteúdo anterior foi restaurado.   Limpar Editor

×   Você não pode colar imagens diretamente. Carregar ou inserir imagens do URL.

×
 Share
Ir para lista de Perguntas


  • Estatísticas dos Fóruns

    • Tópicos
      152,3k
    • Posts
      652,5k
×
×
  • Criar Novo...