Grid entièrement codée et personnalisée avec possibilité de vscrollbar et couleur
Description
Il s'agit d'une grid entièrement personnalisée, avec un VScrollBar qui apparaît lorsque le nombre de lignes dépassent la limite que vous avez fixé. Vous pouvez mettre des conditions pour colorer les cellules. Ce code possède 2 types de grid, l'une avec sélecteur et l'autre sans.
La finalité de ce projet, serait en fait d'en faire un OCX, mais je n'ai pas encore les connaissances suffisantes dans ce domaine, il faudrait que je me penche sur la question etc. Bref, si quelqu'un taquine les OCX et veut bien en faire un à partir de mon code, j'en serait ravi ^^
Dernière petite chose, les form sont limités en nombre de controles, donc évitez de passer de trop gros tableaux dépassant les 3000 lignes...
Source / Exemple :
Option Explicit
Private Tbl() As Variant 'Création d'un tableau à vide en vue d'un dimensionnement dynamique
'Dessine le tableau à partir de la requête sql
Public Sub DesignTable(ByVal cn As ADODB.Connection, ByVal rs As ADODB.Recordset, sql As String, sCpt As Integer, Frm As Form, ParamArray var() As Variant)
Dim i, j, k, cpt, PosX, PosY, Col, Lig, tmp As Integer
rs.Open sql, cn, 1, 2
'sCpt Définition du nombre de lignes à partir desquelles le scroll va commencer à opérer
Col = rs.Fields.Count 'Nb de colonnes
Lig = rs.RecordCount 'Nb de lignes
tmp = 0
'Définition du tableau récupérant les valeurs passées par la table
ReDim Tbl(Col - 1, Lig - 1) As Variant 'Chargement des dimensions réelles du tableau
PosX = Frm.Cell(0).Left 'Récupération de la position initiale
PosY = Frm.Cell(0).Top 'de la cellule en haut à gauche
If var(0) <> 0 Then
Frm.Cell(0).Width = var(0) 'défini la taille des cellule
Frm.Titre(0).Width = var(0)
End If
For i = 0 To UBound(var)
tmp = tmp + var(i) 'Longueur d'une ligne
Next i
'Définition de la taille du cadre qui entoure les cellules.
Frm.Cadre.Height = ((Lig + 1) * Frm.Cell(0).Height) + 30 '+1 à cause des titres
Frm.Cadre.Width = tmp + 30 'épaisseur
'Rend visible, place et initialise les paramètre du VScroll
If Lig > sCpt Then
Frm.VScroll.Min = 1
Frm.VScroll.Max = Lig - sCpt + 1 'Définition de la taille maximale du scroll
Frm.VScroll.Visible = True
Frm.Blanc.Visible = True
Frm.VScroll.Left = Frm.Cell(0).Left + tmp
Frm.VScroll.Height = sCpt * Frm.Cell(0).Height
Frm.VScroll.Top = Frm.Cell(0).Top
Frm.Blanc.Left = Frm.VScroll.Left
Frm.Blanc.Top = Frm.Titre(0).Top
'Définition de la taille du cadre qui entoure les cellules en fonction du scroll
Frm.Cadre.Height = ((sCpt + 1) * Frm.Cell(0).Height) + 30
Frm.Cadre.Width = tmp + Frm.VScroll.Width + 30 'Sélecteur + Vscrool + épaisseur
End If
cpt = Col * Lig 'Nb de cellules totales
k = 0
'Création des titres des cellules
For i = 0 To Col - 1
If i > 0 Then
Load Frm.Titre(i): Frm.Titre(i).Visible = True
Frm.Titre(i).Text = rs.Fields(i).Name 'Récupération du nom des colonnes
Frm.Titre(i).Width = var(i)
Frm.Titre(i).Left = Frm.Titre(i - 1).Left + Frm.Titre(i - 1).Width
Frm.Titre(i).Top = Frm.Titre(0).Top
Else
Frm.Titre(0).Text = rs.Fields(0).Name
End If
Next i
'Remplissage du tableau de Variant
j = 0
While rs.EOF = False
For i = 0 To (Col - 1)
'Si une valeur est null alors on insert une chaine vide dans le tableau
Tbl(i, j) = IIf(IsNull(rs.Fields(i)), vbNullChar, rs.Fields(i))
Next i
j = j + 1
rs.MoveNext
Wend
rs.Close
'Répartition des sélecteurs et des cellules
'Exemple de tableau, les chiffres représentant les index.
'---------------------
'|T0 |T1 |T2 |T3 |T4 |
'---------------------
'| 0 | 1 | 2 | 3 | 4 |
'---------------------
'| 5 | 6 | 7 | 8 | 9 |
'---------------------
k = 0
For j = 0 To (Lig - 1)
For i = 0 To (Col - 1)
'Calcul position des cellules leur affecte les valeurs
If ((i = 0) And (j = 0)) Then
Frm.Cell(k).Text = Tbl(i, j)
Condcoul Frm, k, Col, Lig 'condition couleur
Else
If ((k) Mod (Col) = 0) Then 'Créé et place toutes les cellules qui sont du coté gauche
Frm.Cell(0).Width = var(0)
Load Frm.Cell(k)
If (j < (sCpt)) Then Frm.Cell(k).Visible = True
Frm.Cell(k).Top = Frm.Cell(k - 1).Top + Frm.Cell(k).Height 'le .top de la cellule précédente + la hauteur de la cellule
Frm.Cell(k).Left = Frm.Cell(0).Left
Frm.Cell(k).Text = Tbl(i, j)
Condcoul Frm, k, Col, Lig 'condition couleur
Else
'Crée et place toutes les autres cellules
Frm.Cell(0).Width = var(i)
Load Frm.Cell(k)
If (j < (sCpt)) Then Frm.Cell(k).Visible = True
Frm.Cell(k).Top = Frm.Cell(k - 1).Top
If k = 1 Then
Frm.Cell(1).Left = Frm.Cell(0).Left + var(0)
Else
Frm.Cell(k).Left = Frm.Cell(k - 1).Left + Frm.Cell(k - 1).Width
End If
Frm.Cell(k).Text = Tbl(i, j)
Condcoul Frm, k, Col, Lig 'condition couleur
End If
End If
k = k + 1
Next i
Next j
Frm.Cell(0).Width = var(0)
End Sub
'Place et rend visible les cellules que l'on souhaite voir
Public Sub ReGetCell(Départ As Integer, Frm As Form, ByVal Col As Integer, ByVal Lig As Integer, sCpt As Integer)
Dim k, i, j, PosX, PosY As Integer
PosY = Frm.Titre(0).Top + Frm.Titre(0).Height
PosX = Frm.Titre(0).Left
k = Départ 'N° de la 1ere cellule en haut à gauche
j = 0
'Efface toutes les cellules
For i = 0 To ((Col * Lig) - 1)
Frm.Cell(i).Visible = False
Next i
'Ne fait apparaitre que les cellules nécessaires
For i = Départ To ((Col * sCpt) + Départ - 1)
Frm.Cell(i).Visible = True
Next i
While k < (Départ + (Col * sCpt)) 'Ne place que les cellules concernées
If k = Départ Then 'Place en haut à gauche la cellule
Frm.Cell(k).Top = PosY
Frm.Cell(k).Left = PosX
k = k + 1
Else
For i = 0 To Col - 1
If k <> 1 Then
If k < ((Col * sCpt) + Départ) Then
If ((k) Mod (Col) = 0) Then 'Créé et place toutes les cellules qui sont du coté gauche
Frm.Cell(k).Top = Frm.Cell(k - 1).Top + Frm.Cell(k).Height 'le .top de la cellule précédente + la hauteur de la cellule
Frm.Cell(k).Left = Frm.Cell(Départ).Left
Else
'Crée et place toutes les autres cellules
Frm.Cell(k).Top = Frm.Cell(k - 1).Top
Frm.Cell(k).Left = Frm.Cell(k - 1).Left + Frm.Cell(k - 1).Width
End If
End If
Else 'si k =1
If i > 0 Then
If ((k) Mod (Col) = 0) Then
Frm.Cell(k).Top = Frm.Cell(k - 1).Top + Frm.Cell(k).Height 'le .top de la cellule précédente + la hauteur de la cellule
Frm.Cell(k).Left = Frm.Cell(Départ).Left
Else
Frm.Cell(k).Top = Frm.Cell(k - 1).Top
Frm.Cell(k).Left = Frm.Cell(k - 1).Left + Frm.Cell(k - 1).Width
End If
End If
End If
If k <> 1 Then k = k + 1
If ((k = 1) And (i <> 0)) Then k = k + 1
Next i
j = j + 1
End If
Wend
End Sub
'#####################################################################################################
'# Dessine le tableau avec un sélecteur, attention, il ne faut passer une rq contenant un n°auto #
'#####################################################################################################
'Dessine le tableau à partir de la requête sql - NA = NuméroAuto
Public Sub DesignTableNA(ByVal cn As ADODB.Connection, ByVal rs As ADODB.Recordset, sql As String, sCpt As Integer, Frm As Form, ParamArray var() As Variant)
Dim i, j, l, cpt, PosY, Col, Lig, tmp As Integer
rs.Open sql, cn, 1, 2
'sCpt Définition du nombre de lignes à partir desquelles le scroll va opérer
Col = rs.Fields.Count
Lig = rs.RecordCount
tmp = 0
'Définition du tableau récupérant les valeurs passées par la table
ReDim Tbl(Col - 1, Lig - 1) As Variant 'Chargement des dimensions réelles du tableau
PosY = Frm.Cell(0).Top 'de la cellule en haut à gauche
If var(0) <> 0 Then
Frm.Cell(0).Width = var(0) 'défini la taille des cellule
Frm.Titre(1).Width = var(0)
End If
For l = 0 To UBound(var)
tmp = tmp + var(l) 'Longueur d'une ligne
Next l
'Définition de la taille du cadre qui entoure les cellules.
Frm.Cadre.Height = ((Lig + 1) * Frm.Cell(0).Height) + 30 '+1 à cause des titres
Frm.Cadre.Width = tmp + Frm.Sélecteur(0).Width + 30 'Sélecteur + épaisseur => 375 + 30
'Rend visible, place et initialise les paramètre du VScroll
If Lig > sCpt Then
Frm.VScroll.Min = 1
Frm.VScroll.Max = Lig - sCpt + 1
Frm.VScroll.Visible = True
Frm.Blanc.Visible = True
Frm.VScroll.Left = Frm.Cell(0).Left + tmp
Frm.VScroll.Height = (sCpt) * Frm.Cell(0).Height
Frm.VScroll.Top = Frm.Cell(0).Top
Frm.Blanc.Left = Frm.VScroll.Left
Frm.Blanc.Top = Frm.Titre(1).Top
'Définition de la taille du cadre qui entoure les cellules en fonction du scroll
Frm.Cadre.Height = ((sCpt + 1) * Frm.Cell(0).Height) + 30
Frm.Cadre.Width = tmp + Frm.Sélecteur(0).Width + Frm.VScroll.Width + 30 'Sélecteur + Vscrool + épaisseur
End If
cpt = Col * Lig 'Nb de cellules totales
'Création des titres des cellules
For i = 1 To Col - 1
If i > 1 Then
Load Frm.Titre(i): Frm.Titre(i).Visible = True
Frm.Titre(i).Text = rs.Fields(i).Name
Frm.Titre(i).Width = var(i - 1)
Frm.Titre(i).Left = Frm.Titre(i - 1).Left + Frm.Titre(i - 1).Width
Frm.Titre(i).Top = Frm.Titre(1).Top
Else
'1er Vide
'On ne prend pas le titre du NuméroAuto c'est inutile
Frm.Titre(1).Text = rs.Fields(1).Name
End If
Next i
'Remplissage du tableau de Variant
j = 0
While rs.EOF = False
For i = 0 To (Col - 1)
'Si valeur null alors on insert une chaine vide dans le tableau
Tbl(i, j) = IIf(IsNull(rs.Fields(i)), vbNullChar, rs.Fields(i))
Next i
j = j + 1
rs.MoveNext
Wend
rs.Close
'Répartition des sélecteurs et des cellules
'Exemple de tableau, les chiffres représentant les index.
'------------------------
'|x |T1 |T2 |T3 |T4 |T5 |
'------------------------
'|0>| 1 | 2 | 3 | 4 | 5 |
'------------------------
'|1>| 6 | 7 | 8 | 9 |10 |
'------------------------
For j = 0 To (Lig - 1) 'j = 0 To (sCpt - 1)
For i = 0 To (Col - 1)
'Calcul position des cellules et des sélecteurs
Select Case i
Case 0 'Colonne du sélecteur
If (j = 0) Then '1er sélecteur
Frm.Sélecteur(0).Tag = Tbl(i, j) 'récupération de la clé primaire pr d'éventuelle manipulation
Else 'ligne suivante, on crée les autres sélecteur
Load Frm.Sélecteur(j)
If (j < (sCpt)) Then Frm.Sélecteur(j).Visible = True
Frm.Sélecteur(j).Tag = Tbl(0, j)
Frm.Sélecteur(j).Top = Frm.Sélecteur(0).Top + (Frm.Sélecteur(0).Height * j)
End If
Case Else 'On rentre dans les colonnes des cellules i > 0
tmp = 0 'Change la taille de Cell(0) afin que les cellules créée à partir de cell(0)
Frm.Cell(0).Width = var(i - 1) 'prennent la taille de cette dernière
Load Frm.Cell(i + ((Col - 1) * j))
If (j < (sCpt)) Then Frm.Cell(i + ((Col - 1) * j)).Visible = True
Frm.Cell(i + ((Col - 1) * j)).Text = Tbl(i, j)
Frm.Cell(i + ((Col - 1) * j)).Top = Frm.Sélecteur(j).Top
Frm.Cell(1).Left = Frm.Cell(0).Left
If (((i + ((Col - 1) * j)) - ((Col - 1) * (j - 1))) Mod (Col)) = 0 Then
Frm.Cell(i + ((Col - 1) * j)).Left = Frm.Cell(0).Left 'Si ce sont les cellules du coté gauche
Else 'pour les autres cellules, la position se fait par rapport à la précédente
Frm.Cell(i + ((Col - 1) * j)).Left = Frm.Cell(i + ((Col - 1) * j) - 1).Left + Frm.Cell(i + ((Col - 1) * j) - 1).Width
End If
Condcoul Frm, (i + ((Col - 1) * j)), Col, Lig 'condition couleur
End Select
Next i
Next j
End Sub
'########################################################################################################
'# Place et rend visible les cellules que l'on souhaite voir en fonction du scroll #
'########################################################################################################
Public Sub ReGetCellNA(Départ As Integer, Frm As Form, ByVal Col As Integer, ByVal Lig As Integer, sCpt As Integer)
Dim k, i, j As Integer
k = 0 'Compteur de ligne
j = 0
'Rend toutes les cellules et les sélecteurs invisibles
For i = 0 To ((Col - 1) * Lig)
Frm.Cell(i).Visible = False 'ion
Next i
For i = 0 To Lig - 1
Frm.Sélecteur(i).Visible = False
Next i
'Ne fait apparaître que les cellules nécessaires
For i = 1 + ((Départ - 1) * (Col - 1)) To (((Départ - 1) + sCpt) * (Col - 1))
Frm.Cell(i).Visible = True
Next i
For i = (Départ - 1) To ((sCpt - 1) + (Départ - 1))
Frm.Sélecteur(i).Visible = True
Next i
'Positionnement des cellules et des sélecteurs
For j = (Départ - 1) To ((sCpt - 1) + (Départ - 1))
For i = 0 To (Col - 1)
'Calcul position des cellules et des sélecteurs
Select Case i
Case 0 'Colonne des sélecteurs
If (j = (Départ - 1)) Then '1er sélecteur en haut à gauche
Frm.Sélecteur(Départ - 1).Top = Frm.Cell(0).Top 'récupère la position de départ de cell(0) qui ne bouge pas et qui est invisible
Else 'ligne suivante, on crée les autres sélecteur
Frm.Sélecteur(j).Top = Frm.Sélecteur(Départ - 1).Top + (Frm.Sélecteur(Départ - 1).Height * k)
End If
Case Else 'On rentre dans les colonnes des cellules i > 0
Frm.Cell(i + ((Col - 1) * j)).Top = Frm.Sélecteur(j).Top
'Frm.Cell(i + ((Col - 1) * j)).Left = Frm.Cell(0).Left + (Frm.Cell(0).Width * (i - 1))
If (((i + ((Col - 1) * j)) - ((Col - 1) * (j - 1))) Mod (Col)) = 0 Then
Frm.Cell(i + ((Col - 1) * j)).Left = Frm.Cell(0).Left 'Si ce sont les cellules du coté gauche
Else 'pour les autres cellules, la position se fait par rapport à la précédente
Frm.Cell(i + ((Col - 1) * j)).Left = Frm.Cell(i + ((Col - 1) * j) - 1).Left + Frm.Cell(i + ((Col - 1) * j) - 1).Width
End If
End Select
Next i
k = k + 1 'Incrémentation du compteur de ligne
Next j
End Sub
Conclusion :
La finalité de ce projet, serait en fait d'en faire un OCX, mais je n'ai pas encore les connaissances suffisantes dans ce domaine, il faudrait que je me penche sur la question etc. Bref, si quelqu'un taquine les OCX et veut bien en faire un à partir de mon code, j'en serait ravi ^^
Dernière petite chose, les form sont limités en nombre de controles, donc évitez de passer de trop gros tableaux dépassant les 3000 lignes...
Codes Sources
A voir également
- Grid entièrement codée et personnalisée avec possibilité de vscrollbar et couleur
- Couleur hexadecimal - Forum C# / .NET
- Inverser couleur photoshop - Forum Graphisme/design
- Vba couleur cellule - Forum Visual Basic 6
- Inverser blanc et noir - Forum Visual Basic
- Inverser les couleurs d'une image 16x16 ✓ - Forum Visual Basic 6
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.