Grid Editable 3

Iniciado por ANTRAX, Julio 26, 2010, 10:59:33 AM

Tema anterior - Siguiente tema

0 Miembros y 1 Visitante están viendo este tema.

Julio 26, 2010, 10:59:33 AM Ultima modificación: Julio 08, 2011, 10:10:21 AM por ANTRAX
Código: vb
 Private Function AjustarFecha(ByVal sFecha As String) As String
' Ajustar la cadena introducida a formato de fecha   (27/Abr/01)
Dim i As Long
Dim s As String
'
If sFecha = "" Then
AjustarFecha = ""
Exit Function
End If
'
'On Error Resume Next
On Error GoTo 0
'
' Comprobar si se usan puntos como separador
' si es así, cambiarlos por /
Do
i = InStr(sFecha, ".")
If i Then
Mid$(sFecha, i, 1) = "/"
End If
Loop While i
'
' Comprobar si se usan - como separador
' si es así, cambiarlos por /
Do
i = InStr(sFecha, "-")
If i Then
Mid$(sFecha, i, 1) = "/"
End If
Loop While i
'
s = ""
Do
i = InStr(sFecha, "/")
If i Then
s = s & Right$("0" & Left$(sFecha, i - 1), 2) & "/"
sFecha = Mid$(sFecha, i + 1)
End If
Loop While i
sFecha = s & sFecha
'
If InStr(sFecha, "/") Then
If Len(sFecha) = 5 Then
' Si es igual a 5 caracteres, es que falta el año
sFecha = sFecha & "/"
ElseIf Len(sFecha) < 3 Then
' Si es menor de 3 caracteres es que falta el mes
sFecha = sFecha & "/" & CStr(Month(Now)) & "/"
End If
ElseIf Len(sFecha) < 3 Then
sFecha = sFecha & "/" & CStr(Month(Now)) & "/"
Else
s = ""
For i = 1 To 2
    s = s & "/" & Mid$(sFecha, (i - 1) * 2 + 1, 2)
Next
s = s & "/" & Mid$(sFecha, 5)
sFecha = s
End If
sFecha = Trim$(sFecha)
'
' Comprobar si tiene una barra al principio, si es así, quitarla
If Left$(sFecha, 1) = "/" Then
sFecha = Mid$(sFecha, 2)
End If
' Si tiene una barra al final, es que falta el año
If Right$(sFecha, 1) = "/" Then
sFecha = sFecha & CStr(Year(Now))
End If
'
' Convertir la fecha, por si no se especifican todos los caracteres
' Nota: Aquí puedes usar el formato que más te apetezca
sFecha = Format$(sFecha, "dd/mm/yyyy")
'
' ' Si no es una fecha correcta...
' If IsDate(sFecha) = False Then
' AjustarFecha = sFecha
' Else
'     AjustarFecha = sFecha
' End If
'
Err = 0
'
AjustarFecha = sFecha
End Function

Private Sub CabeceraGrid()
' Asignar las cabeceras del grid y asignación de valores predeterminados
Dim i As Long
'
With Grid2
.FixedRows = 1
.FixedCols = 1
.ScrollBars = flexScrollBarBoth
.AllowUserResizing = flexResizeColumns
.Cols = 11   ' Número de columnas, contando la cabecera
.Rows = 2    ' Número de filas, contando la cabecera
    ' el número de filas se asignará dinámicamente
.ColWidth(0) = 600   ' El ancho de la columna 0
'
' Asignar los nombres de las cabeceras y el ancho de las columnas
.TextArray(1) = "Fecha"
.ColWidth(1) = 1100
.TextArray(2) = "Número"
.ColWidth(2) = 900
.TextArray(3) = "Nombre"
.ColWidth(3) = 1500
.TextArray(4) = "Apellidos"
    .ColWidth(4) = 2000
.TextArray(5) = "Domicilio"
.ColWidth(5) = 2500
.TextArray(6) = "Población"
.ColWidth(6) = 2000
.TextArray(7) = "Provincia"
.ColWidth(7) = 1600
.TextArray(8) = "Teléfonos"
    .ColWidth(8) = 1500
.TextArray(9) = "e-mail"
.ColWidth(9) = 1200
.TextArray(10) = "Observaciones"
.ColWidth(10) = 2500
'
' Mostrar los números en las filas
For i = 1 To .Rows - 1
.TextMatrix(i, 0) = i
Next
'
' Esto indicará que es una nueva fila
' (asignarla a la primera columna de la última fila)
.TextMatrix(.Rows - 1, 0) = cNuevaFila
End With
End Sub

Private Sub BorrarFilas()
' Borrar las filas seleccionadas     (13/May/01)
Dim i As Long
Dim j As Long
Dim k As Long
Dim n As Long
'
' Si está seleccionada la última fila, no borrarla
If Grid2.RowSel = Grid2.Rows - 1 Then
Beep
     Exit Sub
End If
If Grid2.Row = Grid2.Rows - 1 Then
Beep
Exit Sub
End If
'
' Borrar siempre desde la fila mayor a la menor
i = Grid2.Row
j = Grid2.RowSel
If i < j Then
k = i
i = j
    j = k
End If
For n = i To j Step -1
Grid2.RemoveItem n
Next
LastRow = Grid2.Rows - 1
LastCol = 1
Grid2.Col = LastCol
Grid2.Row = LastRow
Grid2.RowSel = LastRow
Grid2.ColSel = LastCol
End Sub