código vba com erro de variável

[Rilton 0]

tenho dois formulários na minha planilha de excel,um cadastra e o outro faz pesquisa em relação ao que está cadastrado. porém estou com um problema no código. sempre quando mando executar o formulário aparace uma mensagem dizendo erro de compilação variável não definida segue em negrito onde aparece esse erro, mas precisamente no evento private sub useform_initialize() o erro aparece neste endereço ".View = lvwReport", já tentei muda-lo mas o erro persiste.

Option Explicit

'constantes para auxiliar na verificação do código
Private Const Ascendente As Byte = 0
Private Const Descendente As Byte = 1
Private caminhoArquivoDados As String


'INICIO - REDIMENSIONAR AUTOMATICAMENTE COLUNAS DO LISTVIEW
'TamanhoColAutomatico - 'Define os Tamanhos das colunas automaticamente
'http://www.vb6.com.br/29/Controles-Microsoft/visual-basic-REDIMENSIONAR-AUTOMATICAMENTE-COLUNAS-DO-LISTVIEW.html
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Const LVM_FIRST = &H1000
Private Const LVM_SETCOLUMNWIDTH = (LVM_FIRST + 30)
Private Const LVSCW_AUTOSIZE = -1
Private Const LVSCW_AUTOSIZE_USEHEADER = -2
'FIM - REDIMENSIONAR AUTOMATICAMENTE COLUNAS DO LISTVIEW

Private Sub btnExportar_Click()
   Call Exportar
End Sub

Private Sub btnFiltrar_Click()
   Call PopulaListBox(txtServico.Text, txtTiposervico.Text, txtcalendar1.Text, txtCalendar2.Text)
End Sub

Private Sub frmFiltros_Click()

End Sub

Private Sub lstLista_DblClick()
Dim linha, Index
Dim i As Integer
Dim oList As Object
Dim indiceRegistro As Long

On Error Resume Next
   Set oList = lstLista.SelectedItem
   If oList Is Nothing Then 'Exit Sub
       lblMensagens.Caption = "É preciso selecionar um item válido na lista"

  Else
           indiceRegistro = frmCadastro.ProcuraIndiceRegistroPodId(lstLista.ListItems.Item(lstLista.SelectedItem.Index))
                    If indiceRegistro <> -1 Then
                       Call frmCadastro.CarregaRegistroPorIndice(indiceRegistro)
                   End If
            Unload Me
   End If
End Sub

Private Sub DefinePlanilhaDados()
   Dim wb As Workbook
   Dim caminhoCompleto As String
   Dim ARQUIVO_DADOS As String
   Dim PASTA_DADOS As String

   ThisWorkbook.Activate

   ARQUIVO_DADOS = Range("ARQUIVO_DADOS").Value
   PASTA_DADOS = Range("PASTA_DADOS").Value

   If ThisWorkbook.Name <> ARQUIVO_DADOS Then
       'monta a string do caminho completo
       If PASTA_DADOS = vbNullString Or PASTA_DADOS = "" Then
           caminhoCompleto = Replace(ThisWorkbook.FullName, ThisWorkbook.Name, vbNullString) & ARQUIVO_DADOS
       Else
           If Right(PASTA_DADOS, 1) = "\" Then
               caminhoCompleto = PASTA_DADOS & ARQUIVO_DADOS
           Else
               caminhoCompleto = PASTA_DADOS & "\" & ARQUIVO_DADOS
           End If
       End If
   End If

   caminhoArquivoDados = caminhoCompleto

End Sub

Private Sub UserForm_Initialize()
   'lv.ListItems.Clear 'Clear ListView from previous filled data
lstLista.ColumnHeaders.Clear 'Clear the Column Headers
lstLista.ListItems.Clear
      With lstLista
       .Gridlines = True
       [b].View = lvwReport[/b]        '.FullRowSelect
  '     .ColumnHeaders.Add Text:="ID", Width:=20
  '     .ColumnHeaders.Add Text:="NOME", Width:=60
  '     .ColumnHeaders.Add Text:="Endereço", Width:=120
  '     .ColumnHeaders.Add Text:="FONE", Width:=30
  '     .ColumnHeaders.Add Text:="CIDADE", Width:=50
   End With

'preenche o cboDirecao e seleciona o primeiro item
   cboDirecao.Clear
   cboDirecao.AddItem "Ascendente"
   cboDirecao.AddItem "Descendente"
   cboDirecao.ListIndex = 0

   Call DefinePlanilhaDados
   Call PopulaCidades
   Call PopulaListBox(vbNullString, vbNullString, vbNullString, vbNullString)
End Sub

Private Sub Exportar()
   Dim i As Integer
   Dim NewWorkBook As Workbook
   Dim rst As ADODB.Recordset
   ' Preenche o RecordSet com os filtros atuais
   Set rst = PreecheRecordSet(txtServico.Text, txtTiposervico.Text, txtcalendar1.Text, txtCalendar2.Text)
   'cria um novo Workbook
   Set NewWorkBook = Application.Workbooks.Add
   ' Efetua loop em todos os campos, retornando os nomes de campos
   ' à planilha.
   For i = 0 To rst.Fields.Count - 1
       NewWorkBook.Sheets(1).Range("A1").Offset(0, i).Value = rst.Fields(i).Name
   Next i

   NewWorkBook.Sheets(1).Range("A2").CopyFromRecordset rst
   NewWorkBook.Activate
End Sub

Private Sub PopulaCidade()
   Dim conn As ADODB.Connection
   Dim rst As ADODB.Recordset
   Dim sql As String

   Set conn = New ADODB.Connection
   With conn
       .Provider = "Microsoft.JET.OLEDB.4.0"
       .ConnectionString = "Data Source=" & caminhoArquivoDados & ";Extended Properties=Excel 8.0;"
       .Open
   End With

   sql = "SELECT DISTINCT Cidade FROM [Programacao$]"

   Set rst = New ADODB.Recordset
   With rst
       .ActiveConnection = conn
       .Open sql, conn, adOpenDynamic, _
             adLockBatchOptimistic
   End With

   Do While Not rst.EOF
       If Not IsNull(rst(0).Value) Then
           lstPlanta.AddItem rst(0).Value
       End If
       rst.MoveNext
   Loop

   ' Fecha o conjunto de registros.
   Set rst = Nothing
   ' Fecha a conexão.
   conn.Close

End Sub

Private Sub PopulaListBox(ByVal Servico As String, _
                         ByVal Tiposervico As String, _
                         ByVal Datainicial As String, _
                         ByVal Datafinal As String)

   On Error GoTo TrataErro

   Dim rst As ADODB.Recordset
   Dim campo As Field
   Dim myArray() As Variant
   Dim i As Integer
Dim li As ListItem, fld As Field, ch As ColumnHeader

Dim Column As Long
Dim Counter As Long
Counter = 0

Set rst = PreecheRecordSet(Servico, Tiposervico, Datainicial, Datafinal)

   'preenche o combobox com os nomes dos campos
   'persiste o índice
   Dim indiceTemp As Long
   indiceTemp = cboOrdenarPor.ListIndex
   cboOrdenarPor.Clear
   For Each campo In rst.Fields
       cboOrdenarPor.AddItem campo.Name
   Next
   'recupera o índice selecionado
   cboOrdenarPor.ListIndex = indiceTemp

       'Colunas a Preencher Inicia na Primeira
       For i = 0 To rst.Fields.Count - 1 'For i = 1 : a partir da 2ª coluna
           Set ch = lstLista.ColumnHeaders.Add(, , rst.Fields(i).Name)
           'ch.Width = 48 'Define o Tamanho de Todas as COLUNAS
           'MsgBox rst.Fields(i).Name
       Next

'Clear the Column Headers
lstPlanta.ListItems.Clear

   'coloca as linhas do RecordSet num Array, se houver linhas neste
   If Not rst.BOF Then
   Do While Not rst.EOF

       'Preenche o LISTVIEW a partir da 2ª Coluna
        'Set li = lstLista.ListItems.Add(, "k" & rst.Fields(0), CheckNull(rst.Fields(1)))
           'Fill in the rest of the columns
           'For i = 2 To rst.Fields.Count - 1
               'li.SubItems(i - 1) = CheckNull(rst.Fields(i))

        'Preenche o LISTVIEW a partir da 1ª Coluna
        Set li = lstPlanta.ListItems.Add(, "k" & rst.Fields(0), CheckNull(rst.Fields(0)))
              'Fill in the rest of the columns
               For i = 1 To rst.Fields.Count - 1
                   li.SubItems(i) = CheckNull(rst.Fields(i))
               Next

                  rst.MoveNext 'Move to next record
            Loop

       'Define os Tamanhos das colunas automaticamente
       Call TamanhoColAutomatico

      End If
    'atualiza o label de mensagens
   If rst.RecordCount <= 0 Then
       lblMensagens.Caption = rst.RecordCount & " registros encontrados"
   Else
       lblMensagens.Caption = rst.RecordCount & " registros encontrados"
   End If


   Exit Sub

   ' Fecha o conjunto de registros.
   Set rst = Nothing
   ' Fecha a conexão.
   'conn.Close

TrataSaida:
   Exit Sub
TrataErro:
   Debug.Print Err.Description & vbNewLine & Err.Number & vbNewLine & Err.Source
       MsgBox Err.Description & vbNewLine & Err.Number & vbNewLine & Err.Source
   Resume TrataSaida
End Sub

Private Sub TamanhoColAutomatico()
Dim Column As Long
Dim Counter As Long
Counter = 0
For Column = Counter To lstLista.ColumnHeaders.Count - 2
SendMessage lstLista.hWnd, LVM_SETCOLUMNWIDTH, Column, LVSCW_AUTOSIZE_USEHEADER
Next
End Sub

Public Function CheckNull(FieldValue As Variant)
On Error GoTo Error

   If IsNull(FieldValue) Then
       CheckNull = ""
   Else
       CheckNull = FieldValue
   End If
  ' Exit Sub
Error:
   'GeneralErrors "CheckNull", Err.Number, Err.Description
   Resume Next
End Function

Private Function PreecheRecordSet(ByVal Servico As String, _
                                 ByVal Tiposervico As String, _
                                 ByVal Datainicial As String, _
                                 ByVal Datafinal As String) As Recordset
   On Error GoTo TrataErro

   Dim conn As ADODB.Connection
   Dim rst As ADODB.Recordset
   Dim sql As String
   Dim sqlWhere As String
   Dim sqlOrderBy As String
   Dim i As Integer
   Dim campo As Field
   Dim myArray() As Variant

   Set conn = New ADODB.Connection
   With conn
       .Provider = "Microsoft.JET.OLEDB.4.0"
       .ConnectionString = "Data Source=" & caminhoArquivoDados & ";Extended Properties=Excel 8.0;"
       .Open
   End With

   sql = "SELECT * FROM [Programacao$]"

   'monta a cláusula WHERE
   'NomeDaEmpresa
   Call MontaClausulaWhere(txtServico.Name, "Servico", sqlWhere)

   'NomeDoContato
   Call MontaClausulaWhere(txtTiposervico.Name, "Tiposervico", sqlWhere)

   'Endereço
   Call MontaClausulaWhere(txtcalendar1.Name, "Datainicial", sqlWhere)

   'Cidade
   For i = 1 To lstPlanta.ListCount
       'verifica se o item está selecionado
       If lstPlanta.Selected(i - 1) Then
           'Monta a cláusula WHERE com OR
           Debug.Print lstPlanta.List(i - 1) & " selecionado"
           If sqlWhere <> vbNullString Then
               sqlWhere = sqlWhere & " OR"
           End If
           sqlWhere = sqlWhere & " UCASE(Cidade) LIKE UCASE('%" & Trim(lstPlanta.List(i - 1)) & "%')"
       End If
   Next

   'Telefone
   Call MontaClausulaWhere(txtCalendar2.Name, "Datafinal", sqlWhere)



   'faz a união da string SQL com a cláusula WHERE
   If sqlWhere <> vbNullString Then
       sql = sql & " WHERE " & sqlWhere
   End If

   'faz a união da string SQL com a cláusula ORDER BY
   If cboOrdenarPor.ListIndex <> -1 Then
       sqlOrderBy = " ORDER BY " & cboOrdenarPor.List(cboOrdenarPor.ListIndex, 0)
       'define a direção
       Select Case cboDirecao.ListIndex
       Case Ascendente
           sqlOrderBy = sqlOrderBy & " ASC"
       Case Descendente
           sqlOrderBy = sqlOrderBy & " DESC"
       End Select
       'une a query order ao sql
       sql = sql & sqlOrderBy
   End If

   Set rst = New ADODB.Recordset
   rst.CursorLocation = adUseClient
   With rst
       .ActiveConnection = conn
       .Open sql, conn, adOpenForwardOnly, _
             adLockBatchOptimistic
   End With

   Set rst.ActiveConnection = Nothing

   ' Fecha a conexão.
   conn.Close

   Set PreecheRecordSet = rst
   Exit Function
TrataErro:
   Set rst = Nothing
End Function

Private Sub MontaClausulaWhere(ByVal NomeControle As String, ByVal NomeCampo As String, ByRef sqlWhere As String)
'NomeDoContato
   If Trim(Me.Controls(NomeControle).Text) <> vbNullString Then
       If sqlWhere <> vbNullString Then
           sqlWhere = sqlWhere & " AND"
       End If
       If NomeCampo <> "Datainicial" And NomeCampo <> "Datafinal" Then
       sqlWhere = sqlWhere & " UCASE(" & NomeCampo & ") LIKE UCASE('%" & Trim(Me.Controls(NomeControle).Text) & "%')"
       ElseIf NomeCampo = "Datainicial" Then
       sqlWhere = sqlWhere & NomeCampo & ">=#" & (Me.Controls(NomeControle).Text) & "# "
       ElseIf NomeCampo = "Datafinal" Then
       sqlWhere = sqlWhere & " " & NomeCampo & "<=#" & (Me.Controls(NomeControle).Text) & "#;"
       End If
   End If
'SELECT * FROM [Programação$] WHERE (([Datainicial]>=#3/1/1966#) AND ([Datafinal]<=#12/31/1967#));
'sqlWhere = sqlWhere &  NomeCampo & ") >=#" & Trim(Me.Controls(NomeControle).Text) & "#)"

End Sub

'Faz a transpasição de um array, transformando linhas em colunas
Private Function Array2DTranspose(avValues As Variant) As Variant
   Dim lThisCol As Long, lThisRow As Long
   Dim lUb2 As Long, lLb2 As Long
   Dim lUb1 As Long, lLb1 As Long
   Dim avTransposed As Variant

   If IsArray(avValues) Then
       On Error GoTo ErrFailed
       lUb2 = UBound(avValues, 2)
       lLb2 = LBound(avValues, 2)
       lUb1 = UBound(avValues, 1)
       lLb1 = LBound(avValues, 1)

       ReDim avTransposed(lLb2 To lUb2, lLb1 To lUb1)
       For lThisCol = lLb1 To lUb1
           For lThisRow = lLb2 To lUb2
               avTransposed(lThisRow, lThisCol) = avValues(lThisCol, lThisRow)
           Next
       Next
   End If

   Array2DTranspose = avTransposed
   Exit Function

ErrFailed:
   Debug.Print Err.Description
   Debug.Assert False
   Array2DTranspose = Empty
   Exit Function
   Resume
End Function

[KhaosDoctor 242]

Você criou a variavel, tipo

 

lst = new listview?