Ok Korn acho q agoooooooooooooooooooooooooooooooooooooooooooora a coisa
vaaaaaaaaaaaaaaaaaaaaaaaaaaaaai!!!!
Segue abaixo versão 1.1 do código q gera a consulta:
***********************************************************
Dim i As Integer, j As Integer, intSQL As Integer
Dim s As String, strSQL As String, strCampo As String
Dim s2() As String, strParteSQL() As String
Dim ObjectAccess As Object
Dim campo As String
Private Sub Command1_Click()
Text1 = Trim(Text1)
If Text1 = "" Then Exit Sub
For i = 1 To Len(Text1)
If Mid(Text1, i, 1) < Chr(48) Or Mid(Text1, i, 1) > Chr(57) Then
If Mid(Text1, i, 1) <> ";" And Mid(Text1, i, 1) <> "-" Or _
VBA.Right(Text1, 1) = ";" Or VBA.Right(Text1, 1) = "-" Then
MsgBox "Existem caracteres inválidos", vbCritical, "Erro no filtro"
Exit Sub
End If
End If
Next
For i = 1 To Len(Text1)
If Mid(Text1, i, 1) = ";" Then j = j + 1
Next
ReDim s2(j) As String
j = 0
For i = Len(Text1) To 1 Step -1
If Mid(Text1, i, 1) <> ";" Then
s = Mid(Text1, i, 1) & s
If i - 1 = 0 Then s2(j) = s
Else
s2(j) = s
s = ""
j = j + 1
End If
Next
For i = 0 To j 'Conta a qtde de intervalos existentes na expressão, exemplo
'de intervalo: 6-8
If InStr(s2(i), "-") > 0 Then intSQL = intSQL + 1
Next
campo = InputBox("Digite o nome do campo a ser filtrado", "Filtro")
If intSQL >= 1 Then
ReDim strParteSQL(intSQL - 1) As String
strSQL = campo & " "
Else
For i = 0 To j 'Formação dos campos avulsos: campo = numero
If i > 0 Then
strSQL = strSQL & " OR " & campo & " = " & s2(i)
Else
strSQL = campo & " = " & s2(i)
End If
Next
GoTo AbreRelatorio
End If
intSQL = 0
For i = 0 To j 'Monta a sentença BETWEEN
If InStr(s2(i), "-") > 0 Then
strParteSQL(intSQL) = " BETWEEN " & Left(s2(i), InStr(s2(i), "-") - 1) & _
" AND " & VBA.Right(s2(i), InStr(StrReverse(s2(i)), "-") - 1)
intSQL = intSQL + 1
End If
Next
intSQL = intSQL - 1
For i = 0 To intSQL 'Formação dos BETWEEN'S
If i = intSQL Then strSQL = strSQL & strParteSQL(i)
If i < intSQL Then strSQL = strSQL & strParteSQL(i) & " OR " & campo & " "
Next
For i = 0 To j 'Formação dos campos avulsos: campo = numero
If InStr(s2(i), "-") = 0 Then
strSQL = strSQL & " OR " & campo & " = " & s2(i)
End If
Next
AbreRelatorio:
'abrindo o relatório
Set ObjectAccess = CreateObject("access.application")
With ObjectAccess
.OpenCurrentDatabase filepath:="C:Caminho_do_banco.mdb" 'caminho do
'banco
.Visible = False
.DoCmd.OpenReport "Etiquetas_Proprietarios", acViewPreview, , strSQL, acWindowNormal
.CloseCurrentDatabase
End With
Set ObjectAccess = Nothing
End Sub
**********************************************************
Acho q agora dará certo... em azul está o q mudei, mas lembre-se de fazer a consistência com os dados q o usuário coloca. Eu procurei fazer o possível mas teste todas as possibilidades q imaginar. Ele aceita somente caracteres numéricos, ponto-e-vírgula, e traço e não aceita ponto-e-vírgula como último caractere ok??
boa sorte, se precisar estamos ae e qq problema é só postar
t+
