' Validar fecha, mm/dd/
' Validar la fecha. formato MM/DD/AA de ekanaban mayo 2006
'
Function vFecha(scr)
Dim oER
set oER = New RegExp
	oER.Pattern = "^(0?[1-9]|1[0-2])/(0?[1-9]|1[0-9]|2|2[0-9]|3[0-1])/(\d{2}|\d{4})$"
oER.Global = True
oER.IgnoreCase = True
vFecha = oER.Test(scr)
if vFecha=true then
	Dim EsCorrecta
	EsCorrecta = IsDate(scr)   ' Returns True = correcta o False = incorrecta.
	vFecha = EsCorrecta 
end if
set oER = nothing
End Function




' validar la fecha. formato dd/mm/AA
Function vFecha2(scr)
Dim oER
set oER = New RegExp
	oER.Pattern = "^(0?[1-9]|1[0-9]|2|2[0-9]|3[0-1])/(0?[1-9]|1[0-2])/(\d{2}|\d{4})$"
oER.Global = True
oER.IgnoreCase = True
vFecha = oER.Test(scr)
set oER = nothing
End Function
' dias transcurridos
' si el valor de dias trascurridos
'	 Es menor a cero la fecha final es menor a la fecha inicial.
'	 Es cero las fechas son iguales
'	 Es mayor la fecha final es mayor que la fecha inicial.	
Function dtranscurridos(finicial,ffinal)
Dim dias
' que formato maneja la computadora dd/mm/yy o mm/dd/yy
dias=DateDiff("d","1/1/2006","1/2/2006")
if dias=1 then 'mm/dd/yy
else 'dd/mm/yy
	' cambiar las fechas al formato de mm/dd/yy a dd/mm/yy 
	dim mmddyyyy
	mmddyyyy = split(finicial,"/")
	finicial = mmddyyyy(1)&"/"&mmddyyyy(0)&"/"&mmddyyyy(2) 
	mmddyyyy = split(ffinal,"/")
	ffinal = mmddyyyy(1)&"/"&mmddyyyy(0)&"/"&mmddyyyy(2) 
end if
dias=DateDiff("d",finicial,ffinal)
dtranscurridos = dias
End Function
' campo en blanco
' contar caracteres ignorando chr(13)&chr(10) ( retorno de carro y avance de línea.) 
' y blancos.
Function cblanco(campo)
Dim ncaracteres
ncaracteres=Trim(Replace(campo,chr(13) & chr(10),chr(32)))
cblanco = Len(ncaracteres)
End Function
' dia de la semana.
Function dsemana(fecha)
Dim dia
Dim ndia
ndia = Weekday(CDate(fecha))
Select Case ndia
 Case 1  dia = "Domingo"
 Case 2  dia = "Lunes"
 Case 3  dia = "Martes"
 Case 4  dia = "Miércoles"
 Case 5  dia = "Jueves"
 Case 6  dia = "Viernes"
 Case 7  dia = "Sábado"
 Case Else     dia = "Error"
End Select
dsemana = dia
End Function
'
' Junio 2003 A. Chavez
'
' Quitar blancos de los campos
Function qblancos(campo)
Dim ncampo
ncampo=Trim(Replace(campo,chr(13) & chr(10),chr(32)))
qblancos = ncampo
End Function
'
' Quitar crlf (caracter 13 y 10)
Function qcrlf(str)
Dim nuevostr
nuevostr=Replace(str,chr(13) & chr(10),"")
qcrlf = nuevostr
End Function
'
' Cambiar string (datos, este, por)
Function crenglon(str,a,b)
Dim nrenglon
nrenglon=Replace(str,a,b)
crenglon = nrenglon
End Function
' ignorar chr(13) y chr(10) ( retorno de carro y avance de línea.) 
'  coma signo de pesos y blancos de los extremos.
' *** esta funcion es para aceptar el copy paste de numero con formato en excel. ***
Function sTrim(str)
str=Replace(str,",","")
str=Replace(str,"$","")
sTrim=Trim(Replace(str,chr(13) & chr(10),chr(32)))
End Function