Redimensionnement automatique colonnes/lignes pour msflexgrid

Commenter

Contenu du snippet

Un simple module qui permet en un seul appel de redimensionner les colonnes et/ou les lignes d'un MsFlexGrid

Aucun autre controle n'est necessaire.

Copier ce code dans un module.

Pour redimensionner toutes les colonnes (TailleAuto MSFlexGrid1, True, False)

Pour redimensionner toutes les lignes (TailleAuto MSFlexGrid1, False,True)

Pour redimensionner toutes les colonnes et les lignes (TailleAuto MSFlexGrid1, True, True)

Bonus (VideFlex MSFlexGrid1) vide le MsFlexGrid.

Source / Exemple : 


Option Explicit
' Taille automatique les largeurs des colonnes  et hauteur de lignes d'un MsFlexGrid
Public Sub TailleAuto(Msflex As MSFlexGrid, PourColonne As Boolean, PourLigne As Boolean)
    Dim Colonne As Long 'N° de colonne
    Dim Ligne As Long 'N de Ligne
    Dim EnteteColonne() As String 'Tableau de stockage des entetes de colonne
    Dim ColonneAlign() As String 'Tableau de stockage du type d'alignement des colonne
    Dim LongTexte() As String 'Tableau de stockage des ligne les plus longue
    Dim TexteFormat As String 'Chaine du FormatString
    Dim Texte As String 'Texte de la cellule en cours
    Dim TexteMultiLigne() As String 'Tableau de stockage des ligne les plus longue en cas de cellule multi-ligne
    Dim NbLigne 'Nombre de ligne dans une cellule multi-ligne
    Dim PosCar As Integer 'Position d'un caractere dans une chaine
    Dim i As Integer 'Juste pour les boucles
    Dim Rafraichissement As Boolean 'Stock le type de rafraichissement
    
    With Msflex 'pour le MsflexGrid
        Rafraichissement = .Redraw
        .Redraw = False
        If PourColonne Then 'si traitement des colonnes
            ReDim EnteteColonne(.Cols) '\
            ReDim ColonneAlign(.Cols)  ' - Redimensionnement des tableaux
            ReDim LongTexte(.Cols)     '/
            
            'Recupere les entetes des colonnes ainsi que leur alignements
            If Msflex.FixedRows <> 0 Then 'Si la premiere ligne est fixe
                For Colonne = 0 To .Cols - 1 'Pour toutes les colonnes
                    ColonneAlign(Colonne) = ""
                    Select Case .ColAlignment(Colonne) 'Analyse de l'alignement
                        Case flexAlignCenterBottom, flexAlignCenterCenter, flexAlignCenterTop
                            ColonneAlign(Colonne) = "^" 'Alignement Centre
                        Case flexAlignLeftBottom, flexAlignLeftCenter, flexAlignLeftTop
                            ColonneAlign(Colonne) = "<" 'Alignement a Gauche
                        Case flexAlignRightBottom, flexAlignRightCenter, flexAlignRightTop
                            ColonneAlign(Colonne) = ">" ''Alignement a Droite
                    End Select
                    EnteteColonne(Colonne) = .TextMatrix(0, Colonne) 'Stock l'entete de colonne
                Next Colonne
            End If
            
            For Colonne = 0 To .Cols - 1 'Pour toutes les colonnes
                LongTexte(Colonne) = ""
                For Ligne = 0 To .Rows - 1 'Pour toutes les lignes
                    Texte = .TextMatrix(Ligne, Colonne) 'recuperation du texte de la cellule en cours
                    If InStr(1, Texte, vbCrLf) <> 0 Then 'detection des texte multi-ligne
                        NbLigne = 1
                        PosCar = 1 'position d'un saut de ligne
                        While InStr(PosCar, Texte, vbCrLf) <> 0 'pour tout les saut de ligne
                            If InStr(PosCar, Texte, vbCrLf) <> 0 Then
                                NbLigne = NbLigne + 1 'incrementation du nombre de ligne
                                PosCar = InStr(PosCar, Texte, vbCrLf) + 1 'saut de ligne suivant
                            End If
                        Wend
                        ReDim TexteMultiLigne(NbLigne) 'Redimensionnement et vidage du tableau
                        TexteMultiLigne() = Split(Texte, vbCrLf) 'stockage des lignes dans le tableau
                        Texte = TexteMultiLigne(0) 'texte le plus long en dans le tableau a l'index 0
                        For i = 1 To NbLigne - 1 'pour tout le tableau
                            If Len(Texte) < Len(TexteMultiLigne(i)) Then Texte = TexteMultiLigne(i) 'si le texte de l'index du tableau et plus long
                        Next i
                    End If
                    If Len(Texte) > Len(LongTexte(Colonne)) Then LongTexte(Colonne) = Texte 'stockage du texte dans le tableau des texte les plus long
                Next Ligne
            Next Colonne
            
            
            'Création de la chaine FormatString
            TexteFormat = ""
            For Colonne = 0 To .Cols - 2
                TexteFormat = TexteFormat & ColonneAlign(Colonne) & LongTexte(Colonne) & "|"
            Next Colonne
            TexteFormat = TexteFormat & ColonneAlign(.Cols - 1) & LongTexte(.Cols - 1)
            
            
            .FormatString = TexteFormat 'Toutes les colonne se redimensionne en fonction du texte le plus long
            
            'Replace les entete des colonnes
            If Msflex.FixedRows <> 0 Then 'Si la premiere ligne est fixe
                For Colonne = 0 To .Cols - 1 'Pour toutes les colonnes
                    .TextMatrix(0, Colonne) = EnteteColonne(Colonne) 'Replace les entete des colonnes
                Next Colonne
            End If
        End If
        If PourLigne Then 'Traitement des lignes
            For Ligne = 0 To .Rows - 1 'Pour toutes les lignes
                For Colonne = 0 To .Cols - 1 'Pour toutes les colonnes
                    Texte = .TextMatrix(Ligne, Colonne) 'recuperation du texte de la cellule en cours
                    NbLigne = 1
                    PosCar = 1 'position d'un saut de ligne
                    While InStr(PosCar, Texte, vbCrLf) <> 0 'pour tout les saut de ligne
                        If InStr(PosCar, Texte, vbCrLf) <> 0 Then
                            NbLigne = NbLigne + 1 'incrementation du nombre de ligne
                            PosCar = InStr(PosCar, Texte, vbCrLf) + 1 'saut de ligne suivant
                        End If
                    Wend
                    If NbLigne > 1 Then 'Si plusieurs lignes
                        If (.RowHeight(Ligne) * NbLigne) > .RowHeight(Ligne) Then .RowHeight(Ligne) = .RowHeight(Ligne) * NbLigne
                    End If
                Next Colonne
            Next Ligne
        End If
        .Redraw = Rafraichissement
    End With
End Sub
' Vider un MsFlexGrid
Public Sub VideFlex(Msflex As MSFlexGrid)
    Msflex.Rows = 2
    Msflex.Clear
End Sub

Conclusion :


Merci pour les critiques ou les félicitations,
meme si elles ne font pas plaisir,
elle sont toujour constructive.

A voir également

S'inscrire maintenant

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.