Bom dia a todos do fórum.
Tenho uma planilha de acompanhamento de quilometragem no formato 000,000 km. Quando estou colocando os valores correspondentes nas abas para alimentação do banco de dados, na tela aparece o seguinte erro: Erro de execução "94" - Null Inválido
Abaixo segue código para se possível alguém me ajudar.
A planilha serve para preencher espaços com cores correspondentes. Agradeço desde já.
Option Base 1
Option Explicit
Const REFCABH = "B1:CW14"
Const REFCABV = "A1:A9925"
Const REFMAPA = "B15:CW9925"
Const QTDITEM = 3
Const EXTSEGMTO = 3
Public wsInspecao As DAO.Workspace
Public dbInspecao As DAO.Database
Public rsRegistro As DAO.Recordset
Public CabecalhoH As Range
Public CabecalhoV As Range
Public Mapeamento As Range
Sub GeraMapeamentoDados(SQL As String, NumItem As Integer, Incremento As Integer, ExibirValor As Boolean)
Dim Km As Double, NumLin As Long, NumCol As Long, RefCel As String
' Abre conjunto registros
Set rsRegistro = dbInspecao.OpenRecordset(SQL, dbOpenSnapshot)
' Processa conjunto registros, gerando mapeamento
While Not rsRegistro.EOF
Km = rsRegistro("km Início").Value
While Km < rsRegistro("km Fim").Value
NumLin = Val(Left$(Format$(Km, "0000.000"), 4)) * QTDITEM + NumItem
NumCol = Val(Mid$(Format$(Km, "0000.000"), 6, 2)) + 1
' Mapeamento.Cells(NumLin, NumCol).Activate
If ExibirValor Then
'Mapeamento.Range(Cells(NumLin, NumCol), Cells(NumLin, NumCol + EXTSEGMTO - 1)).Merge
Mapeamento.Cells(NumLin, NumCol).Value = rsRegistro("Valor").Value
If rsRegistro("Valor").Value >= 2.5 Then
Mapeamento.Cells(NumLin, NumCol).Interior.ColorIndex = Me.Range("BM2").Interior.ColorIndex
ElseIf rsRegistro("Valor").Value >= 1.6 Then
Mapeamento.Cells(NumLin, NumCol).Interior.ColorIndex = Me.Range("AO2").Interior.ColorIndex
Else
Mapeamento.Cells(NumLin, NumCol).Interior.ColorIndex = Me.Range("X2").Interior.ColorIndex
End If
Else
RefCel = "X" & 2 + NumItem - 1
Mapeamento.Cells(NumLin, NumCol).Interior.ColorIndex = Me.Range(RefCel).Interior.ColorIndex
End If
Km = Km + Incremento / 1000
'NumItem = NumItem + 1
Wend
rsRegistro.MoveNext
Wend
' Mapeamento.Cells(1, 1).Activate
' Fecha conjunto registros
rsRegistro.Close
Set rsRegistro = Nothing
End Sub
Sub LimpaMapeamentoDados()
Me.Range(REFMAPA).ClearContents
Me.Range(REFMAPA).ClearFormats
Me.Range(REFMAPA).Borders.LineStyle = xlContinuous
Me.Range(REFMAPA).HorizontalAlignment = xlHAlignCenter
Me.Range(REFMAPA).Cells(1, 1).Activate
End Sub
Private Sub cmdGerarMapeamento_Click()
Dim SQL As String
' Desprotege planilha
Me.Unprotect Me.Name & ".xls"
' Abre banco de dados
Set dbInspecao = OpenDatabase(ThisWorkbook.Path & "" & ThisWorkbook.Name, False, False, "excel 8.0")
' Define ranges
Set CabecalhoH = Me.Range(REFCABH)
Set CabecalhoV = Me.Range(REFCABV)
Set Mapeamento = Me.Range(REFMAPA)
' Limpa área mapeamento na planilha
LimpaMapeamentoDados
' Gera mapeamento dados Desguarnecimento
SQL = ""
SQL = SQL & "select *"
SQL = SQL & " from [Desguarnecimento$]"
SQL = SQL & " order by [km Início]"
GeraMapeamentoDados SQL, 1, 10, False
' Gera mapeamento dados Renovação
SQL = ""
SQL = SQL & "select *"
SQL = SQL & " from [Renovação$]"
SQL = SQL & " order by [km Início]"
GeraMapeamentoDados SQL, 2, 10, False
' Gera mapeamento dados Socaria
SQL = ""
SQL = SQL & "select *"
SQL = SQL & " from [Socaria$]"
SQL = SQL & " order by [km Início]"
GeraMapeamentoDados SQL, 3, 10, False
' Gera mapeamento dados Regulagem Lastro
'SQL = ""
'SQL = SQL & "select *"
'SQL = SQL & " from [Regulagem Lastro$]"
'SQL = SQL & " order by [km Início]"
'GeraMapeamentoDados SQL, 4, 10, False
' Gera mapeamento dados Alivio Tensão
'SQL = ""
'SQL = SQL & "select *"
'SQL = SQL & " order by [km Início]"
'GeraMapeamentoDados SQL, 5, 10, False
' Gera mapeamento dados Preparação Renovação
'SQL = ""
'SQL = SQL & "select *"
'SQL = SQL & " from [Preparação Renovação$]"
'SQL = SQL & " order by [km Início]"
'GeraMapeamentoDados SQL, 6, 10, False
' Fecha banco de dados
dbInspecao.Close
Set dbInspecao = Nothing
' Protege planilha
' Me.Protect Me.Name & ".xls"
End Sub
Private Sub cmdLimparMapeamento_Click()
' Desprotege planilha
' Me.Unprotect Me.Name & ".xls"
' Limpa área mapeamento na planilha
LimpaMapeamentoDados
' Protege planilha
' Me.Protect Me.Name & ".xls"
End Sub
Postado : 09/06/2015 5:45 am