Tipos Incompatíveis na Propriedade Range
Enviado: 31 Mar 2017 às 19:12
Estou tendo dificuldade em verificar a razão do "Erro em tempo de Execução: 13" no código abaixo.
A macro deveria executar a seguinte sequência:
Verificar se existe diferença entre o valor uma célula de um formulário e a célula de um relatório, caso existir a diferença, a macro copia o valor da célula do formulário e cola no relatório de acordo com a posição (linha) de um protocolo.
Quando executo a busca pelo protocolo na coluna "B" do relatório, a macro interrompe a execução devido a este erro.
Abaixo o código:
Sub update_reg()
Application.ScreenUpdating = False
Dim protocol As String
Dim end_old As Long
Dim rmks_old As String
Dim usr_old As String
Dim dt_reg_old As Long
Dim end_new As Long
Dim rmks_new As String
Dim usr_new As String
Dim dt_reg_new As Long
Sheets("Atualizar").Select
protocol = Range("P2").Value
end_old = Range("P5").Value
rmks_old = Range("P3").Value
usr_old = Range("P11").Value
dt_reg_old = Range("P12").Value
end_new = Range("F13").Value
rmks_new = Range("P17").Value
usr_new = Range("P1").Value
dt_reg_new = Range("G4").Value
If end_old <> end_new Then
Sheets("relatorio").Select
Range("B:B").Find(protocol, ActiveCell, xlValues, xlWhole, xlByRows).Activate
ActiveCell.Offset(0, 4).Value = end_new
ActiveCell.Offset(0, 6).Value = dt_reg_new
Sheets("Atualizar").Select
MsgBox "Término Atualizado", vbOKOnly, "Atualizar Registro"
ElseIf usr_old <> usr_new Then
Sheets("relatorio").Select
Range("B:B").Find(protocol, ActiveCell, xlValues, xlWhole, xlByRows).Activate
ActiveCell.Offset(0, 5).Value = usr_new
ActiveCell.Offset(0, 6).Value = dt_reg_new
Sheets("Atualizar").Select
MsgBox "Usuário Atualizado", vbOKOnly, "Atualizar Registro"
ElseIf rmks_old <> rmks_new Then
Sheets("relatorio").Select
Range("B:B").Find(protocol, ActiveCell, xlValues, xlWhole, xlByRows).Activate
ActiveCell.Offset(0, 7).Value = rmks_new
ActiveCell.Offset(0, 6).Value = dt_reg_new
Sheets("Atualizar").Select
MsgBox "Observações Atualizadas", vbOKOnly, "Atualizar Registro"
Else
Sheets("Atualizar").Select
MsgBox "Nenhuma Alteração Efetuada!", vbOKOnly, "Cancelar Atualização de Registro"
End If
Application.ScreenUpdating = True
End Sub
Coloquei os smilies pra indicar as linhas onde o erro acontece
Agradeço desde já a quem puder me ajudar.
Att.;
A macro deveria executar a seguinte sequência:
Verificar se existe diferença entre o valor uma célula de um formulário e a célula de um relatório, caso existir a diferença, a macro copia o valor da célula do formulário e cola no relatório de acordo com a posição (linha) de um protocolo.
Quando executo a busca pelo protocolo na coluna "B" do relatório, a macro interrompe a execução devido a este erro.
Abaixo o código:
Sub update_reg()
Application.ScreenUpdating = False
Dim protocol As String
Dim end_old As Long
Dim rmks_old As String
Dim usr_old As String
Dim dt_reg_old As Long
Dim end_new As Long
Dim rmks_new As String
Dim usr_new As String
Dim dt_reg_new As Long
Sheets("Atualizar").Select
protocol = Range("P2").Value
end_old = Range("P5").Value
rmks_old = Range("P3").Value
usr_old = Range("P11").Value
dt_reg_old = Range("P12").Value
end_new = Range("F13").Value
rmks_new = Range("P17").Value
usr_new = Range("P1").Value
dt_reg_new = Range("G4").Value
If end_old <> end_new Then
Sheets("relatorio").Select
Range("B:B").Find(protocol, ActiveCell, xlValues, xlWhole, xlByRows).Activate

ActiveCell.Offset(0, 4).Value = end_new
ActiveCell.Offset(0, 6).Value = dt_reg_new
Sheets("Atualizar").Select
MsgBox "Término Atualizado", vbOKOnly, "Atualizar Registro"
ElseIf usr_old <> usr_new Then
Sheets("relatorio").Select
Range("B:B").Find(protocol, ActiveCell, xlValues, xlWhole, xlByRows).Activate

ActiveCell.Offset(0, 5).Value = usr_new
ActiveCell.Offset(0, 6).Value = dt_reg_new
Sheets("Atualizar").Select
MsgBox "Usuário Atualizado", vbOKOnly, "Atualizar Registro"
ElseIf rmks_old <> rmks_new Then
Sheets("relatorio").Select
Range("B:B").Find(protocol, ActiveCell, xlValues, xlWhole, xlByRows).Activate

ActiveCell.Offset(0, 7).Value = rmks_new
ActiveCell.Offset(0, 6).Value = dt_reg_new
Sheets("Atualizar").Select
MsgBox "Observações Atualizadas", vbOKOnly, "Atualizar Registro"
Else
Sheets("Atualizar").Select
MsgBox "Nenhuma Alteração Efetuada!", vbOKOnly, "Cancelar Atualização de Registro"
End If
Application.ScreenUpdating = True
End Sub
Coloquei os smilies pra indicar as linhas onde o erro acontece
Agradeço desde já a quem puder me ajudar.
Att.;