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