Tout est dans la class du Form.
La structure IntercalaireCollection permet de fusionner les celles sur toute une ligne.
La structure MergedCellsCollection permet de fusionner les cellules sur n colonnes et n lignes.
Source / Exemple :
'****************************************************************************************
'*** ***
'*** Fusion de cellules sur un DataGridView ***
'*** par l'ajout de LABELS en surchargeant la fonction PAINT de la GridView ***
'*** Il suffit de remplir les structures "intercal" et ou "cellulesFusionnees" ***
'*** dans le form_load ***
'*** ***
'*** Pascal Mauran - Le 30/06/2010 ***
'****************************************************************************************
Imports System
Imports System.Collections.Generic
Imports System.ComponentModel
Imports System.Data
Imports System.Drawing
Imports System.Text
Imports System.Windows.Forms
Public Class Form1
Inherits Form
Public CENTRE = 1
Public GAUCHE = 2
Public DROITE = 3
Private cellulesFusionnees As MergedCellsCollection
Private intercal As IntercalaireCollection
'**********************************************************************************
'*** Structures des intercalaires ***
'**********************************************************************************
Private Structure Intercalaire
Dim y As Integer
Dim valeur As String
Dim lblIntercalaire As Label
End Structure
Private Structure IntercalaireCollection
Dim nbIntercalaire As Integer
Dim pI() As Intercalaire
End Structure
'**********************************************************************************
'*** Structures de cellules fusionnées ***
'**********************************************************************************
Private Structure MergedCells
Dim nbCells As Integer
Dim x1 As Integer
Dim x2 As Integer
Dim y1 As Integer
Dim y2 As Integer
Dim valeur As String
Dim lblMerge As Label
End Structure
Private Structure MergedCellsCollection
Dim nbMergedCells As Integer
Dim pMC() As MergedCells
End Structure
'**********************************************************************************
'*** Fonctions des cellules fusionnées ***
'**********************************************************************************
Public Sub AddMergedCell(ByVal x1 As Integer, ByVal y1 As Integer, ByVal x2 As Integer, ByVal y2 As Integer, ByVal valeur As String)
With cellulesFusionnees
.nbMergedCells = .nbMergedCells + 1
ReDim Preserve .pMC(0 To .nbMergedCells)
.pMC(.nbMergedCells).x1 = x1
.pMC(.nbMergedCells).x2 = x2
.pMC(.nbMergedCells).y1 = y1
.pMC(.nbMergedCells).y2 = y2
.pMC(.nbMergedCells).valeur = valeur
.pMC(.nbMergedCells).lblMerge = New Label
.pMC(.nbMergedCells).lblMerge.AutoSize = False
.pMC(.nbMergedCells).lblMerge.Visible = True
.pMC(.nbMergedCells).lblMerge.Enabled = True
Me.Controls().Add(.pMC(.nbMergedCells).lblMerge)
End With
End Sub
Public Sub SetMergedColorAndAlignement(ByVal numMergeCell As Integer, ByVal couleurFond As Color, ByVal couleurEncre As Color, Optional ByVal alignement As Integer = 1)
cellulesFusionnees.pMC(numMergeCell).lblMerge.BackColor = couleurFond
cellulesFusionnees.pMC(numMergeCell).lblMerge.ForeColor = couleurEncre
If alignement = CENTRE Then
cellulesFusionnees.pMC(numMergeCell).lblMerge.TextAlign = ContentAlignment.MiddleCenter
ElseIf alignement = GAUCHE Then
cellulesFusionnees.pMC(numMergeCell).lblMerge.TextAlign = ContentAlignment.MiddleLeft
Else
cellulesFusionnees.pMC(numMergeCell).lblMerge.TextAlign = ContentAlignment.MiddleRight
End If
End Sub
Public Sub SetMergedPolice(ByVal numMergeCell As Integer, ByVal nom As String, Optional ByVal taille As Integer = 12, Optional ByVal gras As Boolean = True)
Dim f As Font
If gras = True Then
f = New Font(nom, taille, FontStyle.Bold, GraphicsUnit.Point)
Else
f = New Font(nom, taille, FontStyle.Regular, GraphicsUnit.Point)
End If
cellulesFusionnees.pMC(numMergeCell).lblMerge.Font = f
End Sub
'**********************************************************************************
'*** Fonctions des intercalaires ***
'**********************************************************************************
Public Sub AddIntercalaire(ByVal y As Integer, ByVal valeur As String)
With intercal
.nbIntercalaire = .nbIntercalaire + 1
ReDim Preserve .pI(0 To .nbIntercalaire)
.pI(.nbIntercalaire).y = y
.pI(.nbIntercalaire).valeur = valeur
.pI(.nbIntercalaire).lblIntercalaire = New Label
.pI(.nbIntercalaire).lblIntercalaire.AutoSize = False
.pI(.nbIntercalaire).lblIntercalaire.Visible = True
.pI(.nbIntercalaire).lblIntercalaire.Enabled = True
Me.Controls().Add(.pI(.nbIntercalaire).lblIntercalaire)
End With
End Sub
Public Sub SetIntercalaireColorAndAlignement(ByVal numIntercalaire As Integer, ByVal couleurFond As Color, ByVal couleurEncre As Color, Optional ByVal alignement As Integer = 1)
intercal.pI(numIntercalaire).lblIntercalaire.BackColor = couleurFond
intercal.pI(numIntercalaire).lblIntercalaire.ForeColor = couleurEncre
If alignement = CENTRE Then
intercal.pI(numIntercalaire).lblIntercalaire.TextAlign = ContentAlignment.MiddleCenter
ElseIf alignement = GAUCHE Then
intercal.pI(numIntercalaire).lblIntercalaire.TextAlign = ContentAlignment.MiddleLeft
Else
intercal.pI(numIntercalaire).lblIntercalaire.TextAlign = ContentAlignment.MiddleRight
End If
End Sub
Public Sub SetIntercalairePolice(ByVal numIntercalaire As Integer, ByVal nom As String, Optional ByVal taille As Integer = 12, Optional ByVal gras As Boolean = True)
Dim f As Font
If gras = True Then
f = New Font(nom, taille, FontStyle.Bold, GraphicsUnit.Point)
Else
f = New Font(nom, taille, FontStyle.Regular, GraphicsUnit.Point)
End If
intercal.pI(numIntercalaire).lblIntercalaire.Font = f
End Sub
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Dim stMerge As New DataGridViewCellStyle
Dim stC1 As New DataGridViewCellStyle
Dim stM As New DataGridViewCellStyle
Dim fo As New Font("Arial", 10, FontStyle.Bold, GraphicsUnit.Point)
Me.Visible = True
cellulesFusionnees.nbMergedCells = -1
AddMergedCell(2, 4, 5, 5, "Test")
SetMergedColorAndAlignement(0, Color.Black, Color.BurlyWood, CENTRE)
SetMergedPolice(0, "System", 12, True)
AddMergedCell(3, 9, 5, 11, "TEST CELLULES FUSIONNÉES texttexttexttexttexttexttext")
SetMergedColorAndAlignement(1, Color.Bisque, Color.Blue, GAUCHE)
SetMergedPolice(0, "Arial", 14, False)
intercal.nbIntercalaire = -1
AddIntercalaire(0, "GENERALITES")
SetIntercalairePolice(0, "Arial", 8, True)
SetIntercalaireColorAndAlignement(0, Color.Red, Color.White)
AddIntercalaire(7, "CONDITIONNEUSE")
SetIntercalairePolice(1, "Arial", 16, True)
SetIntercalaireColorAndAlignement(1, Color.Green, Color.White)
Grd.SendToBack()
Dim row1 As String() = {"A1", "Fermeture ligne"}
Dim row2 As String() = {"A1", "Ferié"}
Dim row3 As String() = {"A1", "Arrêt plannifié usine"}
Dim row4 As String() = {"A1", "Réunion"}
Dim row5 As String() = {"A1", "Preventif"}
Dim row6 As String() = {"A31", "NEP Long"}
Dim row7 As String() = {"G10", "Changement"}
'*** Police ***
stC1.BackColor = Color.Blue
stC1.ForeColor = Color.White
stC1.Font = New Font("Arial", 12, FontStyle.Bold, GraphicsUnit.Point)
Grd.ColumnCount = 10
Grd.Rows.Add("")
Grd.Rows.Add(row1)
Grd.Rows.Add(row2)
Grd.Rows.Add(row3)
Grd.Rows.Add(row4)
Grd.Rows.Add(row5)
Grd.Rows.Add(row6)
Grd.Rows.Add(row7)
Grd.RowCount = 20
For i = 0 To Grd.Rows.Count - 1
Grd.Rows(i).Cells(0).Style = stC1
Grd.Rows(i).Cells(1).Style = stC1
Next i
'*** Police ***
stM.BackColor = Color.Aquamarine
stM.ForeColor = Color.Black
stM.Font = New Font("Arial", 22, FontStyle.Bold, GraphicsUnit.Point)
stM.Alignment = DataGridViewContentAlignment.MiddleCenter
Grd.Columns(1).Frozen = True
Grd.Columns(1).MinimumWidth = 50
Grd.RowHeadersVisible = False
Grd.ColumnHeadersVisible = True
Grd.Columns(0).ReadOnly = True
Grd.Columns(1).ReadOnly = True
Grd.Columns(0).HeaderText = "Code arrêt"
Grd.Columns(1).HeaderText = "Libellé arrêt"
For i = 2 To Grd.Columns.Count - 1
Grd.Columns(i).HeaderText = Str(i) & "h00"
Grd.Columns(i).HeaderCell.Style = stM
Next
Grd.Columns(0).SortMode = DataGridViewColumnSortMode.NotSortable
Grd.Columns(1).SortMode = DataGridViewColumnSortMode.NotSortable
Me.Refresh()
End Sub
Private Sub Grd_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles Grd.Paint
Dim x, y As Integer
Dim i As Integer
Dim scrollBarSize As Integer
Dim rec As System.Drawing.Rectangle
Dim rec1 As System.Drawing.Rectangle
Dim rec2 As System.Drawing.Rectangle
Dim x1, x2, y1, y2, d As Integer
scrollBarSize = 17
'*********************************************
'*** Traitement des lignes 'Intercalaires' ***
'*********************************************
For i = 0 To intercal.nbIntercalaire
intercal.pI(i).lblIntercalaire.Visible = False
If Grd.Rows(intercal.pI(i).y).Displayed = True Then
intercal.pI(i).lblIntercalaire.Visible = True
If Grd.Rows(intercal.pI(i).y).Visible = True Then
Grd.Rows(intercal.pI(i).y).Height = intercal.pI(i).lblIntercalaire.Font.Size + 10
rec = Grd.GetRowDisplayRectangle(intercal.pI(i).y, True)
intercal.pI(i).lblIntercalaire.Top = rec.Top + Grd.Top
intercal.pI(i).lblIntercalaire.Left = rec.Left + Grd.Left
intercal.pI(i).lblIntercalaire.Width = rec.Width
intercal.pI(i).lblIntercalaire.Height = rec.Height
intercal.pI(i).lblIntercalaire.Text = intercal.pI(i).valeur
Else
intercal.pI(i).lblIntercalaire.Visible = False
End If
End If
Next
'******************************************
'*** Traitement des cellules fusionnées ***
'******************************************
For i = 0 To cellulesFusionnees.nbMergedCells
With cellulesFusionnees.pMC(i)
.lblMerge.Visible = False
'*** Recherche de la première et la dernière cellule visible ***
For x = .x1 To .x2
If Grd.Columns(x).Displayed = True Then
x1 = x
x = .x2 + 1
End If
Next
For y = .y1 To .y2
If Grd.Rows(y).Displayed = True Then
y1 = y
y = .y2 + 1
End If
Next
For x = .x2 To .x1 Step -1
If Grd.Columns(x).Displayed = True Then
x2 = x
x = .x1 - 1
End If
Next
For y = .y2 To .y1 Step -1
If Grd.Rows(y).Displayed = True Then
y2 = y
y = .y1 - 1
End If
Next
'*** Définition de Abscisses, Ordonnées, Hauteur et Largeur du Label ***
rec1 = Grd.GetCellDisplayRectangle(x1, y1, True)
rec2 = Grd.GetCellDisplayRectangle(x2, y2, True)
d = 0
'Redimensionnement en cas de colonne à cheval sur le bord du GridControl
If x2 < .x2 Then
d = Grd.Width - scrollBarSize - rec2.X
End If
rec = Grd.GetCellDisplayRectangle(x2 + 1, y2, True)
'Redimensionnement en cas de ligne à cheval sur le bord du GridControl
If rec1.Top + Grd.Top + rec2.Top - rec1.Top + rec1.Height > Grd.Top + Grd.Height - scrollBarSize Then
.lblMerge.Height = rec2.Top - rec1.Top + rec1.Height - scrollBarSize
Else
.lblMerge.Height = rec2.Top - rec1.Top + rec2.Height
End If
'Application de nouveaux parametres au Label
.lblMerge.Top = rec1.Top + Grd.Top
.lblMerge.Left = rec1.Left + Grd.Left
.lblMerge.Width = rec2.Left - rec1.Left + d
.lblMerge.Text = cellulesFusionnees.pMC(i).valeur
If x1 + x2 > 0 Then
.lblMerge.Visible = True
End If
End With
Next i
End Sub
End Class
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.