Ir para conteúdo
Fórum Script Brasil

cambao

Membros
  • Total de itens

    2
  • Registro em

  • Última visita

Sobre cambao

cambao's Achievements

0

Reputação

  1. cambao

    Fotos do userform para excel

    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
  2. 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:
×
×
  • Criar Novo...