Teste este código, não tive tempo para testa-ló.
Se encontrar erro, me informe pois se eu tiver tempo tento corrigi-los.
Dim i As Integer
Dim j As Integer
Private Sub txtPaginasParaImpressao_KeyPress(KeyAscii As Integer)
If KeyAscii = 44 Then KeyAscii = 59
If txtPaginasParaImpressao.SelStart = 0 And (KeyAscii = 45 Or KeyAscii = 59) Then KeyAscii = 0: Exit Sub
If fu_ValidaCaracteres(KeyAscii) = True Then KeyAscii = 0: Exit Sub
If KeyAscii = 59 Or KeyAscii = 45 Then If fu_ValidaVirgulaTraco() = True Then KeyAscii = 0: Exit Sub
If KeyAscii = 45 Then If fu_ValidaTraco() = True Then KeyAscii = 0
End Sub
Private Function fu_ValidaCaracteres(iCaracter As Integer) As Boolean
If Not IsNumeric(Chr(iCaracter)) Then
Select Case iCaracter
Case 8, 13, 45, 59
Case Else
fu_ValidaCaracteres = True
End Select
End If
End Function
Private Function fu_ValidaTraco() As Boolean
Dim iQtde As Integer
For i = Len(txtPaginasParaImpressao.Text) To 0 Step -1
If Mid(txtPaginasParaImpressao.Text, IIf(txtPaginasParaImpressao.SelStart > iQtde, txtPaginasParaImpressao.SelStart - iQtde, txtPaginasParaImpressao.SelStart), 1) = "-" Then fu_ValidaTraco = True: Exit Function
'If Mid(txtPaginasParaImpressao.Text, IIf(txtPaginasParaImpressao.SelStart > iQtde, txtPaginasParaImpressao.SelStart - iQtde, txtPaginasParaImpressao.SelStart), 1) = ";" Then Exit Function
iQtde = iQtde + 1
Next
iQtde = 0
For i = txtPaginasParaImpressao.SelStart To Len(txtPaginasParaImpressao.Text)
If Mid(txtPaginasParaImpressao, txtPaginasParaImpressao.SelStart + iQtde, 1) = "-" Then fu_ValidaTraco = True: Exit Function
If Mid(txtPaginasParaImpressao, txtPaginasParaImpressao.SelStart + iQtde, 1) = ";" Then Exit Function
iQtde = iQtde + 1
Next
End Function
Private Function fu_ValidaVirgulaTraco() As Boolean
If Len(txtPaginasParaImpressao.Text) = 0 Then
fu_ValidaVirgulaTraco = True
ElseIf Right(txtPaginasParaImpressao.Text, 1) = ";" Or Right(txtPaginasParaImpressao.Text, 1) = "-" Then
fu_ValidaVirgulaTraco = True
ElseIf Mid(txtPaginasParaImpressao.Text, txtPaginasParaImpressao.SelStart, 1) = ";" Or Mid(txtPaginasParaImpressao.Text, txtPaginasParaImpressao.SelStart, 1) = "-" Then
fu_ValidaVirgulaTraco = True
ElseIf Mid(txtPaginasParaImpressao.Text, txtPaginasParaImpressao.SelStart + 1, 1) = ";" Or Mid(txtPaginasParaImpressao.Text, txtPaginasParaImpressao.SelStart + 1, 1) = "-" Then
fu_ValidaVirgulaTraco = True
End If
End Function
Private Sub txtPaginasParaImpressao_LostFocus()
'############ Verifica os tamanhos ###############################
Dim aTexto() As String
Dim iSelStart As Integer
sTexto = Replace(txtPaginasParaImpressao.Text, ";", "X"): sTexto = Replace(sTexto, "-", "X")
aTexto = Split(sTexto, "X")
If UBound(aTexto) > 0 Then
iSelStart = Len(aTexto(0)) + 1
'If UBound(aTexto) > 1 Then
For i = 1 To UBound(aTexto)
iSelStart = iSelStart + Len(aTexto(i)) + 1
If CInt((aTexto(i - 1))) > CInt(aTexto(i)) Then
MsgBox "O valor ( " & aTexto(i - 1) & " ) é maior que o valor ( " & aTexto(i) & " )" & vbCrLf _
& "Os valores devem ser de forma crescente, Ex:" & vbCrLf & vbCrLf _
& "1;3;4-7;10;15;21-29", vbCritical + vbOKOnly
txtPaginasParaImpressao.SelStart = iSelStart - Len(aTexto(i)) - 1
txtPaginasParaImpressao.SelLength = Len(aTexto(i))
txtPaginasParaImpressao.SetFocus
Exit Sub
End If
Next
'End If
End If
'###################################################################
'############### Verifica Repetido #################################
'hehehe, vamos brincar um pouquinho com Matriz
Dim aTexto2() As String
Dim iQtdeRepeticoes() As Integer
Dim iSelStart2 As Integer
sTexto = Replace(txtPaginasParaImpressao.Text, ";", "X"): sTexto = Replace(sTexto, "-", "X")
aTexto2 = Split(sTexto, "X")
ReDim iQtdeRepeticoes(UBound(aTexto2))
If UBound(aTexto2) > 0 Then
iSelStart2 = Len(aTexto2(0)) + 1
For i = 0 To UBound(aTexto2)
iSelStart2 = iSelStart2 + Len(aTexto2(i)) + 1
For j = 0 To UBound(aTexto2)
If aTexto2(i) = aTexto2(j) Then iQtdeRepeticoes(i) = iQtdeRepeticoes(i) + 1
Next
Next
End If
For i = 0 To UBound(iQtdeRepeticoes)
If iQtdeRepeticoes(i) > 1 Then
MsgBox "Não é interessante que se repita a(s) página(s).", vbInformation + vbOKOnly
txtPaginasParaImpressao.SelStart = iSelStart2 '- Len(aTexto2(i)) - 1
txtPaginasParaImpressao.SelLength = Len(aTexto2(i))
txtPaginasParaImpressao.SetFocus
Exit Sub
End If
Next
'###################################################################
End Sub
