Sección de códigos , trucos y ejemplos para visual basic

207 - Propiedad CellForecolor del control FlexGrid

Contenido

Ejemplo 1 - Con el control Data y el MsFlexgrid versión 6.0
Ejemplo 2 - Utilizando un Hierarchical Flexgrid con conexión ADO
Enlaces relacionados

Ejemplo 1

Ejemplo que muestra como resaltar con un color, valores en un control FlexGrid versión 6.0 utilizando la propiedad CellForeColor de la grilla.

El mismo se conecta mediante un Data a una base de datos que tiene una tabla llamada Produtos. Esta tabla tiene dos campos, una NombreProducto y otra Stock

Al presionar un command1, se recorre en un For-Next las filas de la grilla, y de acuerdo al valor introducido en Text1, cambiará el color de la celda usando la propiedad CellForecolor.

vista del formulario con el flexgrid que visualiza los datos que estén por debajo de un valor de color color rojo

Para el ejemplo enlazar el control MsFlexGrid a un control Data en la propiedad DataSource.

En el FormLoad especificar el nombre y ruta de la base de datos y el nombre de la tabla.

Nota: si se va a utilizar para remarcar valores de tipo Currency u otro formato, cambiar la siguiente línea:

If CDbl(MsFlexGrid.Text) < CDbl(Text1) Then

Código fuente en un formulario:

Option Explicit Private Sub Command1_Click() Dim Fila As Integer 'error al no ingrsar un número If Not IsNumeric(Text1) Then MsgBox "Debe ingresar un número", vbInformation, "Error" Exit Sub End If With MSFlexGrid1 ' Recorre las filas For Fila = 1 To MSFlexGrid1.Rows - 1 'Indica la fila y la columna .Row = Fila .Col = 2 'si el valor es menor a 10 se resalta en color rojo _ mediante la propiedad CellForeColor de la celda actual If CDbl(.Text) < CDbl(Text1) Then .CellForeColor = &HFF& End If .Col = 2 Next .ColWidth(0) = 0 .ColWidth(1) = 2000 .ColWidth(2) = 1500 End With End Sub Private Sub Form_Load() 'Cambiar acá la base de datos Data1.DatabaseName = App.Path & "\bd1.mdb" 'Nombre de la tabla para enlazar el Data Data1.RecordSource = "Productos" Me.Caption = " Ejemplo para resaltar valores en MsFlexGrid " End Sub

Ejemplo 2

Este otro ejemplo , a diferencia del anterior que se conecta con el control Data, aqui se realiza la conexión mediante ADO y se utiliza un control Microsoft Hierarchical Flexgrid en vez del control Flexgrid versión 6.0.

También muestra una posible forma de poder remarcar y resaltar datos con criterios de varias columnas.

Nota. En el ejemplo se utiliza la tabla Productos de la base de datos demo de vb, y se buscan los registros por dos criterios.

Donde el campo Unidades existenes sean menores a las indicadas en una caja de texto ( valor numérico )
y por el Campo suspendido indicado en la caja de verificación. ( Valor Boolean )

Descargar código fuente

Option Explicit ' ---------------------------------------------------------------------------------------------- ' \\ -- Descripción : Buscar registros y Remarcar / resaltar valores y datos en grid ' -- Autor : Luciano Lodola -- http://www.recursosvisualbasic.com.ar/ ' ---------------------------------------------------------------------------------------------- ' ---------------------------------------------------------------------------------------------- Private Declare Function SetErrorMode Lib "kernel32" (ByVal wMode As Long) As Long Private Declare Sub InitCommonControls Lib "Comctl32" () ' \\ -- Variables para la conexión a la base de datos Private cn As ADODB.Connection Dim rs As ADODB.Recordset ' ----------------------------------------------------------------------------------------- ' \\ -- Función para configurar propiedades del grid ( apariencia, cargar datos etc .. ) ' ----------------------------------------------------------------------------------------- Private Sub pv_Flexgrid_Initialize(MSHFlex As MSHFlexGrid, cn As ADODB.Connection) ' -- Nuevo recordset Set rs = New ADODB.Recordset ' -- Ejecutar el command SQL de la tabla productos With rs .CursorLocation = adUseClient .Open "SELECT [NombreProducto],[UnidadesEnExistencia],[PrecioUnidad],[Suspendido] From Productos Order by [NombreProducto]", cn, adOpenStatic, adLockOptimistic End With With MSHFlex .AllowUserResizing = flexResizeColumns ' -- Permitir redimensionar por columnas .FixedCols = 0 ' -- Tipo de filas fijas - NO .FixedRows = 1 ' -- Tipo de columnas fijas - SI .ForeColorFixed = vbHighlight ' -- Color de los encabezados .BackColorFixed = vbWhite ' -- BackGround de los encabezados .GridLinesFixed = flexGridDots ' -- Estilo de la linea del Grid de los headers .RowHeight(0) = 450 ' -- Alto de la fila de encabezado .GridColor = RGB(190, 190, 190) ' -- Color de las líneas del Grid .SelectionMode = flexSelectionByRow ' -- Seleccionar fila completa ' -- Enlazar conjunto de registros con el Flexgrid Set .DataSource = rs ' -- recorrer todas las columnas para ajustar el ancho Dim i As Integer For i = 0 To .Cols - 1 .ColWidth(i) = 1700 Next ' -- Refrescar .Refresh End With End Sub ' -------------------------------------------------------------------------------------------- ' \\ -- Botón para remarcar y resaltar datos ' -------------------------------------------------------------------------------------------- Private Sub Command1_Click() Dim Fila As Integer ' -- Comprobar el valor de la caja de texto que no esté vacío If Not IsNumeric(Text1) Then MsgBox "Debe ingresar un número en el campo Unidades existentes", vbInformation, "Error" Exit Sub End If ' -- Guardar la fila y columna activa para restaurar luego de recorrer los datos de la grilla Dim prevRow As Long Dim prevCol As Long With MSHFlexGrid1 ' -- Volver a enlazar el conjunto de registros con el Grid Set .DataSource = rs ' -- Desactivar actualizacón del grid .Redraw = False ' -- Guardar la fila y columna prevRow = .Row prevCol = .Col ' -- Recorrer registros For Fila = 1 To MSHFlexGrid1.Rows - 1 ' -- Asignar fila activa .Row = Fila ' -- Si Campo suspendido = False ... If Check1.Value = 0 Then ' -- Unidades en existencia menores a Text1 If CLng(.TextMatrix(Fila, 1)) <= CDbl(Text1.Text) And CBool(.TextMatrix(Fila, 3)) = Abs(Check1.Value) Then Call pvSetCellForeColor(MSHFlexGrid1, vbRed) End If Else ' -- Unidades en existencia menores a Text1 + Campo suspendido If CLng(.TextMatrix(Fila, 1)) <= CLng(Text1.Text) And CBool(.TextMatrix(Fila, 3)) = CBool(Abs(Check1.Value)) Then Call pvSetCellForeColor(MSHFlexGrid1, vbRed) End If End If Next ' -- Restaurar fila y columna .Col = prevCol .Row = prevRow ' -- Activar actualización .Redraw = True .Refresh End With End Sub ' -------------------------------------------------------------------------------------- ' \\ -- REcorrer los campos y remarcar de color los datos ' -------------------------------------------------------------------------------------- Private Sub pvSetCellForeColor(MSHFlex As MSHFlexGrid, lColor As Long) Dim c As Integer With MSHFlex For c = 0 To .Cols - 1 .Col = c .CellForeColor = lColor Next End With End Sub ' -------------------------------------------------------------------------------------- ' \\ -- Inicio ' -------------------------------------------------------------------------------------- Private Sub Form_Load() Text1.Text = "" Command1.Caption = "Refrescar datos" Call pvConectDataBase ' -- Iniciar conexión Call pv_Flexgrid_Initialize(MSHFlexGrid1, cn) ' -- Iniciar Hierarchical Flexgrid End Sub ' -------------------------------------------------------------------------------------------- ' \\ -- Subrutina para conectar a la base de datos NWIND de Microsoft Visual Studio\VB98\ ' -------------------------------------------------------------------------------------------- Private Sub pvConectDataBase() On Error GoTo Error_Handler Dim sPath As String sPath = "C:\Archivos de programa\Microsoft Visual Studio\VB98\nwind.mdb" If Len(Dir(sPath)) = 0 Then MsgBox "No se ha encoptrado la base de datos NWIND de ejemplo del directorio de instalación de vb", vbCritical, "Error" Unload Me End If ' -- Crear conexión Set cn = New Connection With cn .CursorLocation = adUseClient .Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & sPath & ";Persist Security Info=False" End With ' -- Errores Exit Sub Error_Handler: MsgBox Err.Number & " " & " Error " & Err.Description, vbCritical End Sub ' -------------------------------------------------------------------------------------------- ' \\ -- Cerrar conexión ' -------------------------------------------------------------------------------------------- Private Sub pvCloseDataBase() If Not cn Is Nothing Then If cn.State = adStateOpen Then cn.Close Set cn = Nothing End If End Sub ' -------------------------------------------------------------------------------------------- ' \\ -- Fin ' -------------------------------------------------------------------------------------------- Private Sub Form_Unload(Cancel As Integer) If Not rs Is Nothing Then If rs.State = adStateOpen Then rs.Close Set rs = Nothing End If Call pvCloseDataBase End Sub ' -------------------------------------------------------------------------------------------- ' \\ -- Iniciar InitCommonControls ' -------------------------------------------------------------------------------------------- Private Sub Form_Initialize() Call SetErrorMode(2) Call InitCommonControls End Sub ' -------------------------------------------------------------------------------------------- ' \\ -- Aceptar entrada de solo números en la caja de texto ' -------------------------------------------------------------------------------------------- Private Sub Text1_KeyPress(KeyAscii As Integer) If InStr("0123456789" & Chr(vbKeyBack) & Chr(vbKeyReturn), Chr(KeyAscii)) = 0 Then KeyAscii = 0 End Sub

Recursos vb - Enlaces relacionados

Buscar en Recursos vb