FAQ's de VB6

[GeoAvila]

Código:

 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