Fotos do userform para excel

[cambao]

Ola pessoal

alguém sabe com se faz para carregar um cadastro com fotos numa planilha do excel, utilizando um userform do editor VBA

O problema é mesmo a foto, pois os outros dados é fácil de inserir nas celulas

Agredecia muito a vossa ajudinha

:rolleyes:

[Michelle Alves]

Veja se é o que procura:

http://www.juliobattisti.com.br/forum/foru...83&KW=fotos

[cambao]

Obrigado

Mas não era bem assim. Eu tenho um formulario de cadastro, onde com o seguinte codigo gravo os dados do formulario numa planilha do excel, a foto fica gravada em forma numerica mas quando quero ver os registos no proprio formulario a imagem não roda com os botoes de proximo e anterior, como o resto dos dados.

Option Explicit

Const colCodigoDoFornecedor As Integer = 1
Const colNomeDaEmpresa As Integer = 2
Const colNomeDoContato As Integer = 3
Const colCargoDoContato As Integer = 4
Const colEndereco As Integer = 5
Const colCidade As Integer = 6
Const colRegiao As Integer = 7
Const colCEP As Integer = 8
Const colPais As Integer = 9
Const colTelefone As Integer = 13
Const colFax As Integer = 11
Const colHomePage As Integer = 12
Const colimage As Integer = 10
Const indiceMinimo As Byte = 3
Const corDisabledTextBox As Long = -2147483633
Const corEnabledTextBox As Long = -2147483643

Private wsCadastro As Worksheet
Private indiceRegistro As Long

Private Sub btnCancelar_Click()
    btnOK.Enabled = False
    btnCancelar.Enabled = False
    Call DesabilitaControles
    Call CarregaDadosInicial
    Call HabilitaBotoesAlteracao
End Sub

Private Sub btnOK_Click()
    Dim proximoId As Long

    'Altera
    If optAlterar.Value Then
        Call SalvaRegistro(CLng(txtCodigoFornecedor.Text), indiceRegistro)
        lblMensagem.Caption = "Registro salvo com sucesso"
    End If
    'Novo
    If optNovo.Value Then
        proximoId = PegaProximoId
        'pega a próxima linha
        Dim proximoIndice As Long
        proximoIndice = wsCadastro.UsedRange.Rows.Count + 1
        Call SalvaRegistro(proximoId, proximoIndice)
        txtCodigoFornecedor = proximoId
        lblMensagem.Caption = "Registro salvo com sucesso"
    End If
    'Excluir
    If optExcluir.Value Then
        Dim result As VbMsgBoxResult
        result = MsgBox("Deseja excluir o registro nº " & txtCodigoFornecedor.Text & " ?", vbYesNo, "Confirmação")

        If result = vbYes Then
            wsCadastro.Range(wsCadastro.Cells(indiceRegistro, colCodigoDoFornecedor), wsCadastro.Cells(indiceRegistro, colCodigoDoFornecedor)).EntireRow.Delete
            Call CarregaDadosInicial
            lblMensagem.Caption = "Registro excluído com sucesso"
        End If
    End If

    Call HabilitaBotoesAlteracao
    Call DesabilitaControles

End Sub


Private Sub btnPesquisar_Click()
    frmPesquisa.Show
End Sub

Private Sub frmRegistro_Click()

End Sub

Private Sub Image1_Click()
     Dim fname As String
     ' Display the Open dialog box.
     fname = Application.GetOpenFilename(filefilter:= _
            "Image Files(*.jpg),*.jpg", Title:="Select Image To Open")

     ' Load the picture into the Image control.
    Image1.Picture = LoadPicture(fname)
     

     ' Update the UserForm.
     Me.Repaint


  
End Sub




Private Sub optAlterar_Click()
    If txtCodigoFornecedor.Text <> vbNullString And txtCodigoFornecedor.Text <> "" Then
        Call HabilitaControles
        Call DesabilitaBotoesAlteracao
        'dá o foco ao primeiro controle de dados
        txtNomeEmpresa.SetFocus
    Else
        lblMensagem.Caption = "Não há registro a ser alterado"
    End If
End Sub

Private Sub optExcluir_Click()
    If txtCodigoFornecedor.Text <> vbNullString And txtCodigoFornecedor.Text <> "" Then
        Call DesabilitaBotoesAlteracao
        lblMensagem.Caption = "Modo de exclusão. Confira o dados do registro antes de excluí-lo"
    Else
        lblMensagem.Caption = "Não há registro a ser excluído"
    End If
End Sub

Private Sub optNovo_Click()
    Call LimpaControles
    Call HabilitaControles
    Call DesabilitaBotoesAlteracao
    'dá o foco ao primeiro controle de dados
    txtNomeEmpresa.SetFocus
End Sub



Private Sub UserForm_Initialize()
    Set wsCadastro = ThisWorkbook.Worksheets("Fornecedores")
    Call HabilitaBotoesAlteracao
    Call CarregaDadosInicial
    Call DesabilitaControles
End Sub

Private Sub btnAnterior_Click()
    If indiceRegistro > indiceMinimo Then
        indiceRegistro = indiceRegistro - 1
    End If
    If indiceRegistro > 1 Then
        Call CarregaRegistro
    End If
End Sub

Private Sub btnPrimeiro_Click()
    indiceRegistro = indiceMinimo
    If indiceRegistro > 1 Then
        Call CarregaRegistro
    End If
End Sub

Private Sub btnProximo_Click()
    If indiceRegistro < wsCadastro.UsedRange.Rows.Count Then
        indiceRegistro = indiceRegistro + 1
    End If
    If indiceRegistro > 1 Then
        Call CarregaRegistro
    End If
End Sub

Private Sub btnUltimo_Click()
    indiceRegistro = wsCadastro.UsedRange.Rows.Count
    If indiceRegistro > 1 Then
        Call CarregaRegistro
    End If
End Sub

Private Sub CarregaDadosInicial()
    indiceRegistro = 2
    Call CarregaRegistro
End Sub

Private Sub CarregaRegistro()
'carrega os dados do primeiro registro

    With wsCadastro
        If Not IsEmpty(.Cells(indiceRegistro, colCargoDoContato)) Then
            Me.txtCodigoFornecedor.Text = .Cells(indiceRegistro, colCodigoDoFornecedor).Value
            Me.txtNomeEmpresa.Text = .Cells(indiceRegistro, colNomeDaEmpresa).Value
            Me.txtNomeContato.Text = .Cells(indiceRegistro, colNomeDoContato).Value
            Me.txtCargoContato.Text = .Cells(indiceRegistro, colCargoDoContato).Value
            Me.txtEndereco.Text = .Cells(indiceRegistro, colEndereco).Value
            Me.TxtCidade.Text = .Cells(indiceRegistro, colCidade).Value
            Me.txtRegiao.Text = .Cells(indiceRegistro, colRegiao).Value
            Me.txtCEP.Text = .Cells(indiceRegistro, colCEP).Value
            Me.txtPais.Text = .Cells(indiceRegistro, colPais).Value
            Me.txtTelefone.Text = .Cells(indiceRegistro, colTelefone).Value
            Me.txtFax.Text = .Cells(indiceRegistro, colFax).Value
            Me.txtHomePage.Text = .Cells(indiceRegistro, colHomePage).Value
          ????????????????????????????????????????? Como se carrega a imagem aqui?
        End If
    End With

    Call AtualizaRegistroCorrente
End Sub

Public Sub CarregaRegistroPorIndice(ByVal indice As Long)
'carrega os dados do registro baseado no índice
    indiceRegistro = indice

    Call CarregaRegistro
End Sub

Private Sub SalvaRegistro(ByVal id As Long, ByVal indice As Long)
    With wsCadastro
        .Cells(indice, colCodigoDoFornecedor).Value = id
        .Cells(indice, colNomeDaEmpresa).Value = Me.txtNomeEmpresa.Text
        .Cells(indice, colNomeDoContato).Value = Me.txtNomeContato.Text
        .Cells(indice, colCargoDoContato).Value = Me.txtCargoContato.Text
        .Cells(indice, colEndereco).Value = Me.txtEndereco.Text
        .Cells(indice, colCidade).Value = Me.TxtCidade.Text
        .Cells(indice, colRegiao).Value = Me.txtRegiao.Text
        .Cells(indice, colCEP).Value = Me.txtCEP.Text
        .Cells(indice, colPais).Value = Me.txtPais.Text
        .Cells(indice, colTelefone).Value = Me.txtTelefone.Text
        .Cells(indice, colFax).Value = Me.txtFax.Text
        .Cells(indice, colHomePage).Value = Me.txtHomePage.Text
        .Cells(indice, colimage).Value = Me.Image1.Picture
    End With

    Call AtualizaRegistroCorrente
End Sub
Private Function PegaProximoId() As Long
    Dim rangeIds As Range
    'pega o range que se refere a toda a coluna do código (id)
    Set rangeIds = wsCadastro.Range(wsCadastro.Cells(indiceMinimo, colCodigoDoFornecedor), wsCadastro.Cells(wsCadastro.UsedRange.Rows.Count, colCodigoDoFornecedor))
    PegaProximoId = WorksheetFunction.Max(rangeIds) + 1
End Function

Editado Abril 8, 2009 por kuroi
Adicionar tag CODE

[Michelle Alves]

Complicado....

Você pegou um código pronto do Tomás Vasquez, certo ? E tentou incorporar um Image nele, para que o Image funcione corretamente precisa entender todo o processo do código.

No que primeiramente dá pra falar é que faltou você declarar o objeto Image, assim como é feito com todos os Text. Parece que não mudaria, somente seria outro objeto, mas é preciso ver se a imagem está na mesma planilha que os outros dados, na mesma linha, etc. Isso é com você ....