Vídeo recomendado
https://youtu.be/diWPPPhW-9E

Erro na adaptação de código

Esclarecimentos e dúvidas sob o Modelo de Aplicativo de Cadastro em VBA no Microsoft Excel publicado no site e blog http://www.tomasvasquez.com.br
alessandra.macedo
Colaborador
Colaborador
Mensagens: 15
Registrado em: Seg Nov 03, 2014 5:17 pm

Erro na adaptação de código

Mensagem por alessandra.macedo »

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


Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


Avatar do usuário
Reinaldo
Jedi
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

Mensagem por Reinaldo »

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.


Responder