Charger une msflexgrid ou une listview à partir d'un fichier texte (et vice-versa) en tenant compte de la taille des colonne


Télécharger le projet
Commenter

Description

bonjour,

juste un module qui peut se révéler pratique (aux vues des nombreuses demandes sur le forum) pour remplir une flex ou LV à partir d'un fichier texte, et de créer le fichier selon leur contenu

Source / Exemple : 


'   ---------------------------------------------------------------------------------
'   [AFCK] (PCPT)       Module Mod_ReadWrite                      v1.0.1  05 dec 2007
'   ---------------------------------------------------------------------------------
'
'   Nécessite :
'           Mod_ReadWrite.bas [*]
'           Msflxgrd.ocx "Microsoft FlexGrid Control 6.0 (SP6)"
'           MSCOMCTL.OCX "Microsoft Windows Common Controls 6.0 (SP6)"
'
'
'           ----------------
'             DESCRIPTION
'           ----------------
'           permet de charger et d'enregistrer un fichier texte
'               d'après une MsFlexGrid ou une ListView
'
'
'
'           ----------------
'             HISTORIQUE
'           ----------------
'   v1.0.1      05-12-2007
'                   .GetArrayFile, FileFolderExists, IsArrayNull,
'                       LeftToChar, RightFromChar, SetArrayFile
'                   .FillFlexGridFromFile, SaveFileFromFlexGrid
'                   .FillListViewFromFile, SaveFileFromListView
'
'
'
'           ----------------
'             INFORMATION
'           ----------------
'               .GetArrayFile       : modif de http://www.codyx.org/snippet_lire-toutes-lignes-fichier-texte_22.aspx#67
'               .FileFolderExists   : http://www.codyx.org/snippet_savoir-si-fichier-existe_65.aspx#208
'               .IsArrayNull        : http://www.codyx.org/snippet_savoir-si-tableau-existe-dimension_231.aspx#747
'
'   ---------------------------------------------------------------------------------
'   dernière version                       http://www.vbfrance.com/code.aspx?ID=44934
'   ---------------------------------------------------------------------------------

Option Explicit
'
'   =====================   CONSTANTE       =====================
Private Const INVALID_FILE_ATTRIBUTES       As Long = &HFFFFFFFF
'
'   =====================   API             =====================
Private Declare Function GetFileAttributes Lib "kernel32.dll" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long

'   =============================================================
'                           MéTHODES
'   =============================================================
'
'
'   *- REMPLI UNE FLEXGRID à PARTIR D'UN FICHIER TEXTE -*
Public Sub FillFlexGridFromFile(oFG As MSFlexGrid, ByVal sPath As String, Optional ByVal sColumnsSepar As String = vbTab, Optional ByVal sRowsSepar As String = vbCrLf, Optional ByVal bFirstColAsHeader As Boolean = True)
'   nécessite "Microsoft FlexGrid Control 6.0 (SP6)"

'   récupère le tableau du fichier
    Dim aRows() As String
    Call GetArrayFile(sPath, aRows, sRowsSepar)
    
    With oFG
        .Visible = False
'       tableau rempli ?
        If Not IsArrayNull(aRows) Then
            Dim i As Integer, j As Integer, aCols() As String
'           clear (on laisse une ligne et une colonne pour garder le header de la couleur désirée)
            .Rows = 1: .Cols = IIf(bFirstColAsHeader, 1, 0): .Clear
            For i = 0 To UBound(aRows)
                aCols = Split(aRows(i), sColumnsSepar)
                    If i = 0 Then
'                       header
                        .Rows = 1: .Cols = UBound(aCols) + 1
                        For j = 0 To UBound(aCols)
                            .ColWidth(j) = Val(LeftToChar(aCols(j), ":"))
                            .TextMatrix(0, j) = RightFromChar(aCols(j), ":")
                        Next j
                    Else
'                       cellules
                        .Rows = .Rows + 1
                        For j = 0 To UBound(aCols)
                            .TextMatrix(i, j) = aCols(j)
                        Next j
                    End If
                Erase aCols
            Next i
            Erase aRows
        End If
        .Visible = True
    End With
End Sub
'
'
'   *- ENREGISTRE UNE FLEXGRID DANS UN FICHIER TEXTE -*
Public Sub SaveFileFromFlexGrid(oFG As MSFlexGrid, ByVal sPath As String, Optional ByVal sColumnsSepar As String = vbTab, Optional ByVal sRowsSepar As String = vbCrLf)
'   nécessite "Microsoft FlexGrid Control 6.0 (SP6)"

    Dim aRows() As String, i As Integer, j As Integer
    
    With oFG
'       dimensionne le tableau selon la grid
        ReDim aRows(.Rows - 1)

'       header
        aRows(0) = vbNullString
        For j = 0 To .Cols - 1
            aRows(0) = aRows(0) & CStr(.ColWidth(j)) & ":" & .TextMatrix(0, j) & sColumnsSepar
        Next j
        aRows(0) = LeftToChar(aRows(0), sColumnsSepar, True)

'       cellules
        For i = 1 To .Rows - 1
            aRows(i) = vbNullString
            For j = 0 To .Cols - 1
                aRows(i) = aRows(i) & .TextMatrix(i, j) & sColumnsSepar
            Next j
            aRows(i) = LeftToChar(aRows(i), sColumnsSepar, True)
        Next i
    End With

'   sauve
    Call SetArrayFile(sPath, aRows, sRowsSepar)
    Erase aRows
End Sub
'
'
'   *- REMPLI UNE LISTVIEW à PARTIR D'UN FICHIER TEXTE -*
Public Sub FillListViewFromFile(oLV As ListView, ByVal sPath As String, Optional ByVal sColumnsSepar As String = vbTab, Optional ByVal sRowsSepar As String = vbCrLf)
'   nécessite "Microsoft Windows Common Controls 6.0 (SP6)"

'   récupère le tableau du fichier
    Dim aRows() As String
    Call GetArrayFile(sPath, aRows, sRowsSepar)
    
    With oLV
        .Visible = False
'       tableau rempli?
        If Not IsArrayNull(aRows) Then
            Dim i As Integer, j As Integer, aCols() As String, Litem As ListItem
'           clear
            .ListItems.Clear: .ColumnHeaders.Clear
            For i = 0 To UBound(aRows)
                aCols = Split(aRows(i), sColumnsSepar)
                    If i = 0 Then
'                       header
                        For j = 0 To UBound(aCols)
                            .ColumnHeaders.Add , , RightFromChar(aCols(j), ":")
                            .ColumnHeaders.Item(j + 1).Width = Val(LeftToChar(aCols(j), ":"))
                        Next j
                    Else
'                       cellules
                        Set Litem = .ListItems.Add(, , aCols(0))
                        For j = 1 To UBound(aCols)
                            Litem.SubItems(j) = IIf(LenB(aCols(j)) > 0, aCols(j), vbNullString)
                        Next j
                    End If
                Erase aCols
                Set Litem = Nothing
            Next i
            Erase aRows
        End If
        .Visible = True
    End With
End Sub
'
'
'   *- ENREGISTRE UNE LISTVIEW DANS UN FICHIER TEXTE -*
Public Sub SaveFileFromListView(oLV As ListView, ByVal sPath As String, Optional ByVal sColumnsSepar As String = vbTab, Optional ByVal sRowsSepar As String = vbCrLf)
'   nécessite "Microsoft Windows Common Controls 6.0 (SP6)"

    Dim aRows() As String, i As Integer, j As Integer
    
    With oLV
'       dimensionne le tableau selon la listview
        ReDim aRows(.ListItems.Count)

'       header
        aRows(0) = vbNullString
        For j = 1 To .ColumnHeaders.Count
            aRows(0) = aRows(0) & CStr(Round(.ColumnHeaders.Item(j).Width)) & ":" & .ColumnHeaders(j).Text & sColumnsSepar
        Next j
        aRows(0) = LeftToChar(aRows(0), sColumnsSepar, True)

'       cellules
        For i = 1 To .ListItems.Count
            aRows(i) = .ListItems(i).Text & sColumnsSepar
            For j = 1 To .ColumnHeaders.Count - 1
                aRows(i) = aRows(i) & .ListItems(i).SubItems(j) & sColumnsSepar
            Next j
            aRows(i) = LeftToChar(aRows(i), sColumnsSepar, True)
        Next i
    End With

'   sauve
    Call SetArrayFile(sPath, aRows, sRowsSepar)
    Erase aRows
End Sub

'   =============================================================
'                           PROCéDURES/FONCTIONS
'   =============================================================
'
'
'   *- RETOURNE LE CONTENU D'UN FICHIER, COMPLET ET SOUS FORME DE TABLEAU -*
Private Function GetArrayFile(ByVal sPath As String, Optional ByRef aLines As Variant, Optional ByVal sRowsSepar As String = vbCrLf) As String
    Dim FF As Integer
    If FileFolderExists(sPath) Then
        FF = FreeFile
        Open sPath For Input As #FF
            GetArrayFile = Input(LOF(FF), #FF)
        Close #FF
        aLines = Split(GetArrayFile, sRowsSepar)
    End If
End Function
'
'
'   *- EXISTANCE FICHIER/DOSSIER -*
Private Function FileFolderExists(ByRef vsPath As String) As Boolean
    FileFolderExists = (GetFileAttributes(vsPath) <> INVALID_FILE_ATTRIBUTES)
End Function
'
'
'   *- TABLEAU DIMENSIONNé -*
Private Function IsArrayNull(ByRef aArray() As String) As Boolean
    IsArrayNull = ((Not (Not aArray)) = 0)
End Function
'
'
'   *- GAUCHE JUSQU'à UN CARACTèRE (EXCLUS) -*
Private Function LeftToChar(ByVal sStr As String, ByVal sSepar As String, Optional bLast As Boolean = False) As String
    Dim iPos As Integer
    If bLast Then iPos = InStrRev(sStr, sSepar) * 2 - 1 Else iPos = InStrB(1, sStr, sSepar)
    
    If iPos <= 0 Then
        LeftToChar = vbNullString
    Else
        LeftToChar = LeftB$(sStr, iPos - 1)
    End If
End Function
'
'
'   *- DROITE DEPUIS UN CARACTèRE (EXCLUS) -*
Private Function RightFromChar(ByVal sStr As String, ByVal sSepar As String) As String
    Dim iPos As Integer
    iPos = InStrB(1, sStr, sSepar)
    If iPos = 0 Then
        RightFromChar = vbNullString
    Else
        RightFromChar = RightB$(sStr, LenB(sStr) - iPos - 1)
    End If
End Function
'
'
'   *- SAUVE UN TABLEAU DANS UN FICHIER -*
Private Sub SetArrayFile(ByVal sPath As String, ByRef aLines() As String, Optional sRowsSepar As String = vbCrLf)
    Dim FF As Integer
    FF = FreeFile
    Open sPath For Output As #FF
        Print #FF, Join(aLines, sRowsSepar);
    Close #FF
End Sub

Conclusion :


4 fonctions à utiliser, pas bien compliqué. une form exemple est néanmoins fournie
Télécharger le projet

Codes Sources

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.

Du même auteur (PCPT)