Bonjour tout le monde,

J'ai écrit quelques fonctions pour opérer sur des tableaux structurés via VBA.
J'avoue qu'après quelques heures de test, j'ai les yeux (et les idées) qui se croisent.

J'ai besoin de ces fonctions "génériques" pour un projet en cours, et je souhaiterai avoir des avis et corrections...

Merci par avance.

Voici les codes, par contre, je ne serais pas de retour avant lundi pour vous lire. Pas d'inquiétude donc...

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
Option Explicit
 
Function getPartialArray(Lo As ListObject, Columns) As Variant
'Transfert de certaines colonnes de tableau structuré vers variable tableau
'https://www.developpez.net/forums/d2091033/logiciels/microsoft-office/excel/transfert-certaines-colonnes-tableau-structure-vers-variable-tableau/#post11618243
Dim temp, R As Long, C As Long
    If Lo.ListRows.Count > 0 Then
        temp = Lo.DataBodyRange.Value
        ReDim T(1 To UBound(temp), 1 To UBound(Columns) + 1)
        For R = 1 To UBound(temp)
            For C = 0 To UBound(Columns)
                T(R, C + 1) = temp(R, Lo.ListColumns(Columns(C)).index)
            Next C
        Next R
        getPartialArray = T
    End If
End Function
 
Function getListObject(Name As String, Optional Wbk As Workbook) As ListObject
'Fonction qui retourne un Objet "ListObject" en fonction de son nom, dans toutes les feuilles du classeur.
'Nothing si non trouvé
Dim Wsh As Worksheet, lCounter As Long
    If Wbk Is Nothing Then Set Wbk = ActiveWorkbook
    For Each Wsh In Wbk.Worksheets
        lCounter = 1
        Do While lCounter <= Wsh.ListObjects.Count And getListObject Is Nothing
            If Wsh.ListObjects(lCounter).Name = Name Then Set getListObject = Wsh.ListObjects(lCounter)
            lCounter = lCounter + 1
        Loop
    Next Wsh
End Function
 
Function EditRow(Lo As ListObject, R As Long, Columns, Datas) As Boolean
'Fonction qui modifie les données de certaines colonnes (ou de toutes) d'une ligne
Dim C As Long
    If R <= getLastRow(Lo) And R > 0 Then
        If Lo.ListRows.Count = 0 Then Lo.ListRows.Add
        For C = LBound(Columns) To UBound(Columns)
            Lo.ListColumns(Columns(C)).DataBodyRange.Rows(R).Value = Datas(C)
        Next
        EditRow = True
    End If
End Function
 
Function DeleteRow(Lo As ListObject, R As Long) As Boolean
'Supprime la ligne R, si possible
    If Lo.ListRows.Count > 0 Then
        If R < getLastRow(Lo) And R > 0 Then
            Lo.ListRows(R).Delete
            DeleteRow = True
        End If
    End If
End Function
 
Function InsertRow(Lo As ListObject, R As Long, Columns, Datas) As ListRow
'Insère une ligne et en complète les colonnes
Dim L As ListRow, C As Long
    If R <= getLastRow(Lo) And R > 0 Then
        Set L = Lo.ListRows.Add(R)
        For C = LBound(Columns) To UBound(Columns)
            Lo.ListColumns(Columns(C)).DataBodyRange.Rows(R).Value = Datas(C)
        Next
        Set InsertRow = L
    End If
End Function
 
Function InsertColumn(Lo As ListObject, Optional ColumnName As String, Optional position As Integer) As ListColumn
'Insère une colonne nommée ColumnName, à l'endroit position. Si omis, à droite du tableau
Dim L As ListColumn
    If position = 0 Then
        Set L = Lo.ListColumns.Add
    Else
        Set L = Lo.ListColumns.Add(position:=Abs(position))
    End If
    If ColumnName <> vbNullString Then L.Name = ColumnName
    Set InsertColumn = L
End Function
 
Function DeleteColumn(Lo As ListObject, ColumnName As String) As Boolean
'Supprime la colonne ColumnName, si possible
Dim Rng As Range
    Set Rng = Lo.HeaderRowRange.Find(ColumnName)
    If Not Rng Is Nothing Then
        Lo.ListColumns(ColumnName).Delete
        DeleteColumn = True
    End If
End Function
 
Function getLastRow(Lo As ListObject) As Long
'Première "ligne vide"
    getLastRow = 1
    If Lo.ListRows.Count > 0 Then getLastRow = getLastRow + Lo.ListRows.Count
End Function
 
Function FindRow(Lo As ListObject, What As Variant, ColumnName As String) As Long
'Retourne le numéro de la ligne ou l'on trouve la valeur What dans la colonne ColumnName
'0 (zéro) si non trouvé
Dim Rng As Range, rngResult As Range
    If Lo.ListRows.Count > 0 Then
        Set Rng = Lo.HeaderRowRange.Find(ColumnName)
        If Not Rng Is Nothing Then
            Set rngResult = Lo.ListColumns(ColumnName).DataBodyRange.Find(What)
            If Not rngResult Is Nothing Then FindRow = rngResult.Row - Lo.HeaderRowRange.Row
        End If
    End If
End Function
Connaissant très mal le modèle objet "ListObject", j'ai surement oublié pas mal de choses....
Merci