Bom dia
Adaptei o userform do Tomas, mas estou com erro ao carregá-lo, dá erro ao carregar imagem, se insisto após 3 tente novamente carrega.
Mas quando tentei agora colocar um duploclique no listbox para acessar outro formulario e carregar os dados dele (cadastro), está dando erro 13, tipos incompativeis.
Poderiam ver onde errei?
muito obrigada
Segue código do form:
'Modelo de Aplicativo de Cadastro em VBA no Microsoft Excel
'Autor: Tomás Vásquez
'http://www.tomasvasquez.com.br
'http://tomas.vasquez.blog.uol.com.br
'março de 2008
Option Explicit
Const colCOD As Integer = 1
Const colREGIONAL As Integer = 2
Const colIMAGEM As Integer = 3
Const colMUNICÍPIOS_COM_PROMOTORIA As Integer = 4
Const colMUNICÍPIOS_ATENDIDOS As Integer = 5
Const colMUNICÍPIOS_COM_100000_HABITANTES As Integer = 6
Const colPOPULAÇÃO_TOTAL_MUNICÍPIOS_ATENDIDOS As Integer = 7
Const colIDH_MÉDIO As Integer = 8
Const colPPIC As Integer = 9
Const colINQUÉRITOS_CIVIS As Integer = 10
Const colAÇÃO_CIVIL_PÚBLICA_EM_ANDAMENTO As Integer = 11
Const colAÇÃO_CIVIL_COM_ACORDO_JUDICIAL As Integer = 12
Const colSEDES_PRÓPRIAS As Integer = 13
Const colSEDES_LOCADAS As Integer = 14
Const colÁREA_TOTAL_LOCADA As Integer = 15
Const colSEDES_CEDIDAS As Integer = 16
Const colUNIDADES_EM_FÓRUM As Integer = 17
Const colÁREA_UTILIZADA_EM_FÓRUNS As Integer = 18
Const colTERRENOS As Integer = 19
Const colTOTAL_MEMBROS As Integer = 20
Const colMEMBROS_PHAB As Integer = 21
Const indiceMinimo As Byte = 2
Const corDisabledTextBox As Long = -2147483633
Const corEnabledTextBox As Long = -2147483643
Private LINHA As Integer
Private coluna As Integer
Private linhalistbox As Integer
Private valor_celula As String
Private conta_registros As Integer
Private valor_pesquisado As String
Private Sub BtnImprimirFicha_Click()
If cmbRegional = "" Then
MsgBox ("Defina Regional")
Exit Sub
Else
Call EnviarExcel
wsFichaR.Select
frmRegional.Hide
frmFichaRegional.Show
End If
End Sub
Private Sub cmbRegional_change()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
valor_pesquisado = cmbRegional.Value
Call CarregaRegistro
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton1_Click()
Unload Me
UserForm2.Show
End Sub
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim valor_listar As String
Dim selecao As Integer
On Error Resume Next
selecao = Me.ListBox1.ListIndex
valor_listar = Me.ListBox1.List(selecao, 0)
frmCadastro.txtEndereço = valor_listar
indiceRegistro = frmCadastro.ProcuraIndiceRegistroPodId(valor_listar)
If indiceRegistro <> -1 Then
Call frmCadastro.CarregaRegistroPorIndice(indiceRegistro)
Else
End If
Unload Me
Call FecharBD(0, 0)
Load frmCadastro
frmCadastro.Show
End Sub
Private Sub UserForm_Initialize()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Call DefinePlanilhaDados
Call CarregaDadosInicial
Call DesabilitaControles
Dim verifica_repetidos As Variant
Dim numero_item1 As Integer
Dim numero_item2 As Integer
txtcomprom = Format(txtcomprom, "#,##0")
txtatendidos = Format(txtatendidos, "#,##0")
txtgrande = Format(txtgrande, "#,##0")
txttotal = Format(txttotal, "#,##0")
txtppic = Format(txtppic, "#,##0")
txtinqcivis = Format(txtinqcivis, "#,##0")
txtação = Format(txtação, "#,##0")
txtsent = Format(txtsent, "#,##0")
txtpróprias = Format(txtpróprias, "#,##0")
txtlocadas = Format(txtlocadas, "#,##0")
txtcedidas = Format(txtcedidas, "#,##0")
txtfórum = Format(txtfórum, "#,##0")
txtterreno = Format(txtterreno, "#,##0")
txttotalmembros = Format(txttotalmembros, "#,##0")
txtmembrosphab = Format(txtmembrosphab, "#,##0")
txtmédia = Format(txtmédia, "#.#0")
txtáreafórum = Format(txtáreafórum, "#.#0")
txtárealocada = Format(txtárealocada, "#.#0")
With wbCadastro
wsRegional.Select
cmbRegional.Clear
LINHA = 2
Do Until wsRegional.Cells(LINHA, 2) = ""
cmbRegional.AddItem wsRegional.Cells(LINHA, 2)
LINHA = LINHA + 1
Loop
For verifica_repetidos = 0 To 5
For numero_item1 = 0 To cmbRegional.ListCount - 1
For numero_item2 = 0 To cmbRegional.ListCount - 1
If numero_item1 > cmbRegional.ListCount - 1 Or numero_item2 > cmbRegional.ListCount - 1 Then
Exit For
Else
If numero_item1 <> numero_item2 Then
If cmbRegional.List(numero_item1) = cmbRegional.List(numero_item2) Then
cmbRegional.RemoveItem (numero_item2)
End If
End If
End If
Next numero_item2
Next numero_item1
Next verifica_repetidos
cmbRegional.SetFocus
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Private Sub CarregaDadosInicial()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Me.cmbRegional.Text = ""
Me.txtimagem.Text = "MAPA REGIONAIS.jpg"
Me.txtcomprom.Text = ""
Me.txtatendidos.Text = ""
Me.txtgrande.Text = ""
Me.txttotal.Text = ""
Me.txtmédia.Text = ""
Me.txtppic.Text = ""
Me.txtinqcivis.Text = ""
Me.txtação.Text = ""
Me.txtsent.Text = ""
Me.txtpróprias.Text = ""
Me.txtlocadas.Text = ""
Me.txtárealocada.Text = ""
Me.txtcedidas.Text = ""
Me.txtfórum.Text = ""
Me.txtáreafórum.Text = ""
Me.txtterreno.Text = ""
Me.txttotalmembros.Text = ""
Me.txtmembrosphab.Text = ""
Dim lin As Integer
Dim coluna As Integer
Dim linhalistbox As Integer
Dim valor_celula As String
Dim conta_registros As Integer
ListBox1.Clear
With wbCadastro
lin = 2
coluna = 4 'coluna da busca na planilha
linhalistbox = 0
conta_registros = 0
wbCadastro.Activate
With wsCadastro
Do Until wsCadastro.Cells(lin, coluna).Value = ""
valor_celula = .Cells(lin, coluna).Value
If UCase(Left(valor_celula, Len(valor_pesquisado))) = UCase(valor_pesquisado) Then
With ListBox1
ListBox1.ColumnWidths = "300;100;80;80;60;60;60;60"
.AddItem
.List(linhalistbox, 0) = wsCadastro.Cells(lin, 2)
.List(linhalistbox, 1) = wsCadastro.Cells(lin, 3)
.List(linhalistbox, 2) = wsCadastro.Cells(lin, 6)
.List(linhalistbox, 3) = wsCadastro.Cells(lin, 7)
.List(linhalistbox, 4) = wsCadastro.Cells(lin, 17)
.List(linhalistbox, 5) = wsCadastro.Cells(lin, 19)
.List(linhalistbox, 6) = wsCadastro.Cells(lin, 20)
.List(linhalistbox, 7) = wsCadastro.Cells(lin, 48)
linhalistbox = linhalistbox + 1
conta_registros = conta_registros + 1
End With
End If
lin = lin + 1
Loop
If ListBox1.ListCount > 0 Then
lbl_registros = ListBox1.ListCount - 1
Else
lbl_registros = "0"
End If
wsRegional.Select
lin = 2
coluna = 2
Do Until wsRegional.Cells(lin, coluna).Value = ""
valor_celula = .Cells(lin, coluna).Value
If UCase(Left(valor_celula, Len(valor_pesquisado))) = UCase(valor_pesquisado) Then
Me.txtimagem.Text = wsRegional.Cells(lin, 3)
Me.txtcomprom.Text = wsRegional.Cells(lin, 4)
Me.txtatendidos.Text = wsRegional.Cells(lin, 5)
Me.txtgrande.Text = wsRegional.Cells(lin, 6)
Me.txttotal.Text = wsRegional.Cells(lin, 7)
Me.txtmédia.Text = wsRegional.Cells(lin, 8)
Me.txtppic.Text = wsRegional.Cells(lin, 9)
Me.txtinqcivis.Text = wsRegional.Cells(lin, 10)
Me.txtação.Text = wsRegional.Cells(lin, 11)
Me.txtsent.Text = wsRegional.Cells(lin, 12)
Me.txtpróprias.Text = wsRegional.Cells(lin, 13)
Me.txtlocadas.Text = wsRegional.Cells(lin, 14)
Me.txtárealocada.Text = wsRegional.Cells(lin, 15)
Me.txtcedidas.Text = wsRegional.Cells(lin, 16)
Me.txtfórum.Text = wsRegional.Cells(lin, 17)
Me.txtáreafórum.Text = wsRegional.Cells(lin, 18)
Me.txtterreno.Text = wsRegional.Cells(lin, 19)
Me.txttotalmembros.Text = wsRegional.Cells(lin, 20)
Me.txtmembrosphab.Text = wsRegional.Cells(lin, 21)
End If
lin = lin + 1
Loop
txtcomprom = Format(txtcomprom, "#,##0")
txtatendidos = Format(txtatendidos, "#,##0")
txtgrande = Format(txtgrande, "#,##0")
txttotal = Format(txttotal, "#,##0")
txtppic = Format(txtppic, "#,##0")
txtinqcivis = Format(txtinqcivis, "#,##0")
txtação = Format(txtação, "#,##0")
txtsent = Format(txtsent, "#,##0")
txtpróprias = Format(txtpróprias, "#,##0")
txtlocadas = Format(txtlocadas, "#,##0")
txtcedidas = Format(txtcedidas, "#,##0")
txtfórum = Format(txtfórum, "#,##0")
txtterreno = Format(txtterreno, "#,##0")
txttotalmembros = Format(txttotalmembros, "#,##0")
txtmembrosphab = Format(txtmembrosphab, "#,##0")
txtmédia = Format(txtmédia, "#.#0")
txtáreafórum = Format(txtáreafórum, "#.#0")
txtárealocada = Format(txtárealocada, "#.#0")
End With
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Private Sub CarregaRegistro()
'carrega os dados do primeiro registro
Application.DisplayAlerts = False
Application.ScreenUpdating = False
LINHA = 2
valor_pesquisado = cmbRegional.Text
coluna = 2
wbCadastro.Activate
With wsRegional
Do Until wsRegional.Cells(LINHA, 1) = "" 'vai executar o laço até encontrar uma célula vazia
'condicção para localizar o registro
If wsRegional.Cells(LINHA, 2) = valor_pesquisado Then 'se encontrar o valor registro na célula pesquisada
wsRegional.Cells(LINHA, 2).Select 'será selecionada a célula
Me.txtCOD.Text = wsRegional.Cells(LINHA, colCOD).Value
Me.cmbRegional.Text = wsRegional.Cells(LINHA, colREGIONAL).Value
Me.txtimagem.Text = wsRegional.Cells(LINHA, colIMAGEM).Value
Me.txtcomprom.Text = wsRegional.Cells(LINHA, colMUNICÍPIOS_COM_PROMOTORIA).Value
Me.txtatendidos.Text = wsRegional.Cells(LINHA, colMUNICÍPIOS_ATENDIDOS).Value
Me.txtgrande.Text = wsRegional.Cells(LINHA, colMUNICÍPIOS_COM_100000_HABITANTES).Value
Me.txttotal.Text = wsRegional.Cells(LINHA, colPOPULAÇÃO_TOTAL_MUNICÍPIOS_ATENDIDOS).Value
Me.txtmédia.Text = wsRegional.Cells(LINHA, colIDH_MÉDIO).Value
Me.txtppic.Text = wsRegional.Cells(LINHA, colPPIC).Value
Me.txtinqcivis.Text = wsRegional.Cells(LINHA, colINQUÉRITOS_CIVIS).Value
Me.txtação.Text = wsRegional.Cells(LINHA, colAÇÃO_CIVIL_PÚBLICA_EM_ANDAMENTO).Value
Me.txtsent.Text = wsRegional.Cells(LINHA, colAÇÃO_CIVIL_COM_ACORDO_JUDICIAL).Value
Me.txtpróprias.Text = wsRegional.Cells(LINHA, colSEDES_PRÓPRIAS).Value
Me.txtlocadas.Text = wsRegional.Cells(LINHA, colSEDES_LOCADAS).Value
Me.txtárealocada.Text = wsRegional.Cells(LINHA, colÁREA_TOTAL_LOCADA).Value
Me.txtcedidas.Text = wsRegional.Cells(LINHA, colSEDES_CEDIDAS).Value
Me.txtfórum.Text = wsRegional.Cells(LINHA, colUNIDADES_EM_FÓRUM).Value
Me.txtáreafórum.Text = wsRegional.Cells(LINHA, colÁREA_UTILIZADA_EM_FÓRUNS).Value
Me.txtterreno.Text = wsRegional.Cells(LINHA, colTERRENOS).Value
Me.txttotalmembros.Text = wsRegional.Cells(LINHA, colTOTAL_MEMBROS).Value
Me.txtmembrosphab.Text = wsRegional.Cells(LINHA, colMEMBROS_PHAB).Value
End If
LINHA = LINHA + 1
Loop
End With
txtcomprom = Format(txtcomprom, "#,##0")
txtatendidos = Format(txtatendidos, "#,##0")
txtgrande = Format(txtgrande, "#,##0")
txttotal = Format(txttotal, "#,##0")
txtppic = Format(txtppic, "#,##0")
txtinqcivis = Format(txtinqcivis, "#,##0")
txtação = Format(txtação, "#,##0")
txtsent = Format(txtsent, "#,##0")
txtpróprias = Format(txtpróprias, "#,##0")
txtlocadas = Format(txtlocadas, "#,##0")
txtcedidas = Format(txtcedidas, "#,##0")
txtfórum = Format(txtfórum, "#,##0")
txtterreno = Format(txtterreno, "#,##0")
txttotalmembros = Format(txttotalmembros, "#,##0")
txtmembrosphab = Format(txtmembrosphab, "#,##0")
txtmédia = Format(txtmédia, "#.#0")
txtáreafórum = Format(txtáreafórum, "#.#0")
txtárealocada = Format(txtárealocada, "#.#0")
ListBox1.Clear
wbCadastro.Activate
LINHA = 2
coluna = 4 'coluna da busca na planilha
linhalistbox = 0
conta_registros = 0
With wsCadastro
While .Cells(LINHA, coluna).Value <> Empty
valor_celula = .Cells(LINHA, coluna).Value
If UCase(Left(valor_celula, Len(valor_pesquisado))) = UCase(valor_pesquisado) Then
With ListBox1
ListBox1.ColumnWidths = "300;100;80;80;60;60;60;60"
.AddItem
.List(linhalistbox, 0) = wsCadastro.Cells(LINHA, 2)
.List(linhalistbox, 1) = wsCadastro.Cells(LINHA, 3)
.List(linhalistbox, 2) = wsCadastro.Cells(LINHA, 6)
.List(linhalistbox, 3) = wsCadastro.Cells(LINHA, 7)
.List(linhalistbox, 4) = wsCadastro.Cells(LINHA, 17)
.List(linhalistbox, 5) = wsCadastro.Cells(LINHA, 19)
.List(linhalistbox, 6) = wsCadastro.Cells(LINHA, 20)
.List(linhalistbox, 7) = wsCadastro.Cells(LINHA, 48)
linhalistbox = linhalistbox + 1
conta_registros = conta_registros + 1
End With
End If
LINHA = LINHA + 1
Wend
End With
If ListBox1.ListCount > 0 Then
lbl_registros = ListBox1.ListCount - 1
Else
lbl_registros = "0"
End If
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Private Sub AtualizarRegional(ByVal ReadOnly As Boolean)
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim caminhoCompleto As String
'fecha o arquivo de dados e tenta abrí-lo
'guarda o caminho
caminhoCompleto = wbCadastro.FullName
wbCadastro.Saved = True
wbCadastro.Close SaveChanges:=False
'abre o arquivo em modo escrita
Set wbCadastro = Workbooks.Open(FileName:=caminhoCompleto, ReadOnly:=ReadOnly)
'oculta a janela
wbCadastro.Windows(1).Visible = False
'reatribui a planilha de cadastro
Set wsRegional = wbCadastro.Worksheets(nomePlanilhaRegional)
Set wsFichaR = ThisWorkbook.Worksheets(nomePlanilhaFichaRegional)
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Private Sub LimpaControles()
Me.cmbRegional.Text = ""
Me.txtimagem.Text = ""
Me.txtcomprom.Text = ""
Me.txtatendidos.Text = ""
Me.txtgrande.Text = ""
Me.txttotal.Text = ""
Me.txtmédia.Text = ""
Me.txtppic.Text = ""
Me.txtinqcivis.Text = ""
Me.txtação.Text = ""
Me.txtsent.Text = ""
Me.txtpróprias.Text = ""
Me.txtlocadas.Text = ""
Me.txtárealocada.Text = ""
Me.txtcedidas.Text = ""
Me.txtfórum.Text = ""
Me.txtáreafórum.Text = ""
Me.txtterreno.Text = ""
Me.txttotalmembros.Text = ""
Me.txtmembrosphab.Text = ""
Me.cmbRegional.Value = False
Me.txtimagem.Value = False
Me.txtcomprom.Value = False
Me.txtatendidos.Value = False
Me.txtgrande.Value = False
Me.txttotal.Value = False
Me.txtmédia.Value = False
Me.txtppic.Value = False
Me.txtinqcivis.Value = False
Me.txtação.Value = False
Me.txtsent.Value = False
Me.txtpróprias.Value = False
Me.txtlocadas.Value = False
Me.txtárealocada.Value = False
Me.txtcedidas.Value = False
Me.txtfórum.Value = False
Me.txtáreafórum.Value = False
Me.txtterreno.Value = False
Me.txttotalmembros.Value = False
Me.txtmembrosphab.Value = False
Image_endereçor.Picture = Nothing
End Sub
Private Sub DesabilitaControles()
Me.txtimagem.Locked = True
Me.txtcomprom.Locked = True
Me.txtatendidos.Locked = True
Me.txtgrande.Locked = True
Me.txttotal.Locked = True
Me.txtmédia.Locked = True
Me.txtppic.Locked = True
Me.txtinqcivis.Locked = True
Me.txtação.Locked = True
Me.txtsent.Locked = True
Me.txtpróprias.Locked = True
Me.txtlocadas.Locked = True
Me.txtárealocada.Locked = True
Me.txtcedidas.Locked = True
Me.txtfórum.Locked = True
Me.txtáreafórum.Locked = True
Me.txtterreno.Locked = True
Me.txttotalmembros.Locked = True
Me.txtmembrosphab.Locked = True
Me.txtimagem.BackColor = corDisabledTextBox
Me.txtcomprom.BackColor = corDisabledTextBox
Me.txtatendidos.BackColor = corDisabledTextBox
Me.txtgrande.BackColor = corDisabledTextBox
Me.txttotal.BackColor = corDisabledTextBox
Me.txtmédia.BackColor = corDisabledTextBox
Me.txtppic.BackColor = corDisabledTextBox
Me.txtinqcivis.BackColor = corDisabledTextBox
Me.txtação.BackColor = corDisabledTextBox
Me.txtsent.BackColor = corDisabledTextBox
Me.txtpróprias.BackColor = corDisabledTextBox
Me.txtlocadas.BackColor = corDisabledTextBox
Me.txtárealocada.BackColor = corDisabledTextBox
Me.txtcedidas.BackColor = corDisabledTextBox
Me.txtfórum.BackColor = corDisabledTextBox
Me.txtáreafórum.BackColor = corDisabledTextBox
Me.txtterreno.BackColor = corDisabledTextBox
Me.txttotalmembros.BackColor = corDisabledTextBox
Me.txtmembrosphab.BackColor = corDisabledTextBox
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = vbFormControlMenu Then
MsgBox "Você não pode fechar esta janela, por favor use o Botão VOLTAR!!!"
Cancel = True
End If
Call FecharBD(0, 0)
End Sub
Private Sub txtimagem_Change()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
On Error GoTo erro_carregamento
If txtimagem = "" Then
Image_endereçor.Picture = LoadPicture(Replace(ThisWorkbook.Path, "01-Controle_Unidades", "05-Banco_de_Dados_Engenharia\FOTOS UNIDADES\") & "SEM FOTO.jpg")
Image_endereçor.PictureSizeMode = fmPictureSizeModeStretch
Else
Image_endereçor.Picture = LoadPicture(Replace(ThisWorkbook.Path, "01-Controle_Unidades", "05-Banco_de_Dados_Engenharia\FOTOS UNIDADES\") & txtimagem.Text)
Image_endereçor.PictureSizeMode = fmPictureSizeModeStretch
End If
erro_carregamento:
MsgBox "Ocorreu um erro ao carregar a imagem. Tente novamente"
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Private Sub EnviarExcel()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'cria varíavel para contagem da linha a ser preenchida
Dim Nlin As Integer
'cria uma variável para contar as linhas da listbox
Dim Cont As Integer
ThisWorkbook.Activate
Sheets("FICHA REGIONAL").Select
'limpa a região com dados anteriores
Range("A32:I5000").ClearContents
Range("d2") = Me.cmbRegional.Text
Range("d3") = Me.txtimagem.Text
Range("e8") = Me.txtcomprom.Text
Range("e10") = Me.txtatendidos.Text
Range("e12") = Me.txtgrande.Text
Range("e14") = Me.txttotal.Text
Range("e17") = Me.txtmédia.Text
Range("e19") = Me.txtppic.Text
Range("e21") = Me.txtinqcivis.Text
Range("e23") = Me.txtação.Text
Range("e25") = Me.txtsent.Text
Range("e27") = Me.txttotalmembros.Text
Range("e29") = Me.txtmembrosphab.Text
Range("h8") = Me.txtpróprias.Text
Range("h12") = Me.txtlocadas.Text
Range("h13") = Me.txtárealocada.Text
Range("h16") = Me.txtcedidas.Text
Range("h18") = Me.txtfórum.Text
Range("h19") = Me.txtáreafórum.Text
Range("h23") = Me.txtterreno.Text
'linha inicial da planilha que carregará os dados
Nlin = 31
'preenche as outras linhas até o fim da listbox
For Cont = 0 To Me.ListBox1.ListCount - 1
Range("b" & Nlin + 1) = Me.ListBox1.List(Cont, 0)
Range("c" & Nlin + 1) = Me.ListBox1.List(Cont, 1)
Range("d" & Nlin + 1) = Me.ListBox1.List(Cont, 2)
Range("e" & Nlin + 1) = Me.ListBox1.List(Cont, 3)
Range("f" & Nlin + 1) = Me.ListBox1.List(Cont, 4)
Range("g" & Nlin + 1) = Me.ListBox1.List(Cont, 5)
Range("h" & Nlin + 1) = Me.ListBox1.List(Cont, 6)
Range("i" & Nlin + 1) = Me.ListBox1.List(Cont, 7)
Nlin = Nlin + 1
Next
ThisWorkbook.Activate
With Worksheets("FICHA REGIONAL")
Dim imgReg As StdPicture
If Me.txtimagem = "" Then
.imgReg.Picture = LoadPicture(Replace(ThisWorkbook.Path, "01-Controle_Unidades", vbNullString) & "05-Banco_de_Dados_Engenharia\FOTOS UNIDADES\" & "SEM FOTO.jpg")
.imgReg.PictureSizeMode = fmPictureSizeModeStretch
Else
.imgReg.Picture = LoadPicture(Replace(ThisWorkbook.Path, "01-Controle_Unidades", vbNullString) & "05-Banco_de_Dados_Engenharia\FOTOS UNIDADES\" & Me.txtimagem)
.imgReg.PictureSizeMode = fmPictureSizeModeStretch
End If
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Vídeo recomendado
https://youtu.be/diWPPPhW-9E
https://youtu.be/diWPPPhW-9E
Erro na adaptação de código
-
- Colaborador
- Mensagens: 15
- Registrado em: Seg Nov 03, 2014 5:17 pm
- Reinaldo
- Jedi
- Mensagens: 1537
- Registrado em: Sex Ago 01, 2014 4:09 pm
- Localização: Garça - SP / SCS - SP
Re: Erro na adaptação de código
Vai ser um tanto quanto difícil obter uma resposta somente com os códigos. Fica praticamente impossível identificar as alterações efetuadas, bem como tentar simular seu novo modelo.