¿Quién dice que es dificil hacer un gráfico en Access?, sin llegar a tener toda la potencia de Excel, podemos obtener resultados mas que aceptables con MS-Graph.
Access 2000. Descargar
Fuente: Emilio Sancha
El siguiente ejemplo muestra como obligar a introducir datos en un determinado campo para poder continuar. En el caso de quedar los campos vacíos los ‘ilumina’ amarilleando el fondo.
Access 2000. Descargar
El ejemplo utiliza la siguiente función, se ayuda de la propiedad InformaciónAdicional (Tag) donde se establece el valor ‘Campo obligatorio’ en aquellos campos que sean imprescindible para poder continuar.
Function CamposObligatorios() As Boolean Dim ctl As Control CamposObligatorios = False For Each ctl In Me.Controls If InStr(ctl.Tag, "Campo obligatorio") <> 0 Then If IsNull(ctl) Or ctl = vbNullString Or ctl = 0 Then ctl.BackColor = RGB(255, 255, 196) CamposObligatorios = True Else ctl.BackColor = RGB(255, 255, 255) End If End If Next End Function
Con el siguiente código se calcula el número de días laborables entre dos fechas. Si se le pasan los argumentos opcionales NombreTablaFestivos y NombreCampoFestivo, tiene también en cuenta los días festivos que estén guardados en un campo con nombre NombreCampoFestivo en la tabla con nombre NombreTablaFestivos.
Public Function DiasLaborables(FechaDesde As Date, FechaHasta As Date, Optional NombreTablaFestivos As String, Optional NombreCampoFestivo As String) As Long
Dim Laborables As Long
On Error GoTo DiasLaborables_Error
Laborables = 1 + (FechaHasta - FechaDesde)
If NombreTablaFestivos <> "" And NombreCampoFestivo <> "" Then
Laborables = Laborables - DCount("*", NombreTablaFestivos, "[" & NombreCampoFestivo & "] Between #" & Format(FechaDesde, "mm/dd/yyyy") & "# AND #" & Format(FechaHasta, "mm/dd/yyyy") & "#")
End If
Laborables = Laborables - DateDiff("ww", FechaDesde, FechaHasta, vbSaturday)
Laborables = Laborables - DateDiff("ww", FechaDesde, FechaHasta, vbSunday)
Laborables = Laborables + (Weekday(FechaDesde, vbSunday) = 1)
Laborables = Laborables + (Weekday(FechaDesde, vbSaturday) = 1)
DiasLaborables = Laborables
On Error GoTo 0
Exit Function
DiasLaborables_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description &") in procedure DiasLaborables"
End Function
Una forma muy atractiva de mostrar datos en un subformulario.
Access 97. Descargar
Fuente: www.access.vis.pl
Public Function IsWritable(ByVal filePath As String) As Boolean
If Right(filePath, 1) = “\” Then filePath = Left(filePath, Len(filePath) – 1)
If Len(Dir(filePath)) > 0 Then
IsWritable = IsFileWritable(filePath)
ElseIf Len(Dir(filePath, vbDirectory)) > 0 Then
IsWritable = IsFileWritable(filePath & “\” & “~.txt”)
If Len(Dir(filePath & “\” & “~.txt”)) > 0 Then Kill filePath & “\” & “~.txt”
Else
IsWritable = IsFileWritable(filePath)
If Len(Dir(filePath)) > 0 Then Kill filePath
End If
End Function
Public Function IsFileWritable(ByVal filePath As String) As Boolean
On Error Resume Next
Err.Clear
Dim nFileNum As Integer
nFileNum = FreeFile
Open filePath For Append As nFileNum
Print #nFileNum, ” “
Close nFileNum
IsFileWritable = (Err.Number = 0)
End Function
Fuente: Alex & Access
Aprovechando que el Pisuerga pasa por Valladolid, allá va la siguiente función:
Public Function EsBisiesto(Anho As Long) As Boolean
EsBisiesto = (Anho Mod 400 = 0) Or ((Anho Mod 100 <> 0) And (Anho Mod 4 = 0))
End Function
Fuente: Foro de Access y VBA
Function DCEAN(numero As String) As String
‘Funcion de cálculo del DC de un código EAN 13
On Error GoTo ctrlerrorEan
Dim a As Integer
Dim strNum(12) As Integer
Dim resultado As Integer
Dim decena As Integer
Dim digito As Integer
If Len(numero) < 12 Then
DCEAN = numero
Exit Function
End If
If Len(numero) > 13 Then
DCEAN = numero
MsgBox “Número de longitud superior a norma” & vbCrLf & “EAN-13″, vbInformation, “EAN-13″
Exit Function
End If
If Len(numero) = 13 Then
He aquí una manera de validar los datos de los TextBox y otros controles que tengan el evento KeyPress. Es simple pero funcional.
Primero añadimos esta función:
Function ValiText(KeyIn As Integer, ValidateString As String, Editable As Boolean) As Integer
Dim ValidateList As String
Dim KeyOut As Integer
If Editable = True Then
ValidateList = UCase(ValidateString) & Chr(8)
Else
ValidateList = UCase(ValidateString)
End If
If InStr(1, ValidateList, UCase(Chr(KeyIn)), 1) > 0 Then
KeyOut = KeyIn
Else
KeyOut = 0
Beep
End If
ValiText = KeyOut
End Function
Luego, por cada control cuya entrada queramos validar, sólo pon algo como esto en el evento KeyPress del control:
KeyAscii=ValiText(Keyascii, “0123456789/-”,True)
El siguiente ejemplo muestra como colorear los botones de access. El ejemplo muestra como colorear el boton cuando se hace click sobre el botón así como cuando recibe el foco.
Para utilizar sólo ha que añadir el módulo ButtonEffects copiar pegar los botones del ejemplo existentes en la base de datos.
Access 97. Descargar
Fuente: Peter's software
En algunas ocasiones tenemos una cadena con caracteres “molestos”, es decir, caracteres menores del ASC(32), comillas, etc., por ejemplo como resultado de la encriptación de un string “normal”.
Si queremos guardar dichos caracteres en un fichero de texto, base de datos, etc, podremos tener problemas.
Para evitarlos podemos aplicar unas funciones sobre el string que nos devuelva una cadena sólo con caracteres “correctos”.
Suponiendo que no podamos preveer el rango de caracteres que podemos encontrar ni la cantidad de caracteres “raros” (lo que nos posibilitaría emplear algoritmos cuyo resultado fuera de la misma o similar longitud al original) podremos emplear este par de funciones :
Para convertir a cadena sin caracteres “raros” :
Function PasaANumeros(texto As String) As String
Dim i As Long, aux As String, s As String
aux = “”
For i = 1 To Len(texto)
s = Hex(Asc(Mid(texto, i, 1)))
If Len(s) = 1 Then s = “0″ & s
aux = aux + s
Next i
PasaANumeros = aux
End Function
Para recuperar la cadena original :
Function PasaATexto(numeros As String) As String
Dim i As Long, aux As String
aux = “”
For i = 1 To Len(numeros) Step 2
aux = aux + Chr(“&H” & Mid(numeros, i, 2))
Next i
PasaATexto = aux
Fuente: www.jrubi.com
