Cleiton, se entendi corretamente, é só colocar algumas condições no inicio da rotina "Sub RelatórioForm()" efetuando a verificação da diferença das Datas :
Troque sua rotina "Sub RelatórioForm()" pela a abaixo :
Nesta coloquei a condição que se a Data Final for maior que 1 ano da Data Inicial, emitirá a mensagem e atribuirá a nova data a Data Final realizando a pesquisa somente no período válido, se não quiser que a rotina continue, habilite a instrução "Exit Sub"
Sub RelatórioForm()
Dim dtData1 As Date ' data inicial de cálculo
Dim dtData2 As Date ' data final
Dim dtFutura As Date
dtData1 = txtDataInicial ' data inicial
dtFutura = dtData1 + 366 ' Calcula data inicial daqui 1 ano
dtData2 = txtDataFinal ' data final
If dtData2 > dtFutura Then
MsgBox "A Data :- " & dtData2 & Chr(13) & _
"está fora do limite de 1 ano" & Chr(13) _
& "A pesquisa será realizada até" & Chr(13) & _
"A Data :- " & dtFutura
'Devolve a última Data valida ao TextBox txtDataFinal
txtDataFinal = dtFutura
'Se não quiser que continue, Habilite a instrução abaixo
'Exit Sub
End If
On Error Resume Next
Application.EnableEvents = False
Dim lastRow As Long
Dim lastResultRow As Long
Dim x As Long
' Verifica qual a ultima célula preenchida
lastRow = Plan1.Cells(Rows.Count, 1).End(xlUp).Row
lastResultRow = 2 'linha resultado
Me.ListView1.ListItems.Clear
' Ciclo em todas as linhas
For x = 2 To lastRow '1 Linha dados pequisa
' verifica se o valor é igual ao da pesquisa
If CDate(Plan1.Cells(x, 5).Value) >= CDate(txtDataInicial.Value) And CDate(Plan1.Cells(x, 5)) <= CDate(txtDataFinal) Then
' Copia os valores
ListView1.ListItems.Add 1, , Plan1.Cells(x, 1).Value
ListView1.ListItems(1).ListSubItems.Add 1, , Plan1.Cells(x, 2).Value
ListView1.ListItems(1).ListSubItems.Add 2, , Plan1.Cells(x, 3).Value
ListView1.ListItems(1).ListSubItems.Add 3, , Format(Plan1.Cells(x, 4).Value, "#,##0.00")
ListView1.ListItems(1).ListSubItems.Add 4, , CDate(Plan1.Cells(x, 5).Value)
'ListView1.ListItems(1).ListSubItems.Add 5, , Plan1.Cells(x, 6).Value
ListView1.ListItems(1).ListSubItems.Add 5, , Plan1.Cells(x, 6).Value
ListView1.ListItems(1).ListSubItems.Add 6, , Plan1.Cells(x, 7).Value
ListView1.ListItems(1).ListSubItems.Add 7, , Plan1.Cells(x, 8).Value
ListView1.ListItems(1).ListSubItems.Add 8, , Plan1.Cells(x, 9).Value
ListView1.ListItems(1).ListSubItems.Add 9, , Plan1.Cells(x, 10).Value
ListView1.ListItems(1).ListSubItems.Add 10, , Plan1.Cells(x, 11).Value
ListView1.ListItems(1).ListSubItems.Add 11, , Plan1.Cells(x, 12).Value
lastResultRow = lastResultRow + 1
End If
Next
Application.EnableEvents = True
End Sub
Se não for isto, retorne.
[]s
Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel
Postado : 31/03/2012 9:15 pm