Bonjour Dranreb, j'ai essayé d'appliquer des ajouts de champs dans le fichier :
- admettons que le je veux ajouter un champ InfoP et InfoF
1- j'ajoute les bvariable dans le module Noterlien à savoir
For L = 1 To UBound(TDon)
' ajoute des deux champs InfoP et InfoF
NoterLien TDon(L, CA), TDon(L, CA + 1), TDon(L, CA + 2), TDon(L, 5 - CA), TDon(L, 6 - CA), TDon(L, 7 - CA), Descend, Cln
Next L
2- dans la classe je les déclare
-InfoP
Property Let InfoP(ByVal RHS As String)
If Not IsEmpty(RHS) Then SonInfo = RHS
End Property
Property Get InfoP() As String
InfoP = SonInfo
End Property
- Infos
Property Let InfoP(ByVal RHS As String)
If Not IsEmpty(RHS) Then SonInfo = RHS
End Property
Property Get InfoP() As String
InfoP = SonInfo
End Property
je récupère bien mes champs sauf au moment de poser tout que je me perd :
Private Sub PoserTout(TRés(), L As Long, ByVal C As Integer, ByVal Chose As Chose)
If C + 2 > UBound(TRés, 2) Then ReDim Preserve TRés(1 To UBound(TRés, 1), 1 To C + 2)
TRés(L + 1, C) = Chose.Nom
TRés(L + 1, C + 1) = Chose.Dsgn
TRés(L + 1, C + 2) = Chose.Info
If Chose.Fils.Count = 0 Then
L = L + 1
Else
Dim FilsChose As Chose
For Each FilsChose In Chose.Fils
PoserTout TRés, L, C + 2, FilsChose
Next FilsChose
End If
Do While C > 2
C = C - 2
If IsEmpty(TRés(L, C)) Then
TRés(L, C) = TRés(L - 1, C)
TRés(L, C + 1) = TRés(L - 1, C + 1)
End If
Loop
End Sub
Property Let TableauRetaillé(ByVal LOt As ListObject, Optional ByVal LMax As Long, TVals())
Dim Trop As Long, CMax As Long, TFml(), F As Long
If LMax = 0 Then LMax = UBound(TVals, 1)
Trop = LOt.ListRows.Count - LMax
If Trop > 0 Then
LOt.ListRows(LMax + 1).Range.Resize(Trop).Delete xlShiftUp
ElseIf Trop < 0 And LMax + Trop > 1 Then
LOt.ListRows(LMax + Trop).Range.Resize(-Trop).Insert xlShiftDown, xlFormatFromLeftOrAbove
End If
CMax = UBound(TVals, 2) + 1
Trop = LOt.ListColumns.Count - CMax
If Trop > 0 Then
LOt.ListColumns(CMax + 1).Range.Resize(, Trop).Delete xlShiftToLeft
ElseIf Trop < 0 And CMax + Trop > 1 Then
LOt.ListColumns(CMax + Trop).Range.Resize(, -Trop).Insert xlShiftToRight, xlFormatFromLeftOrAbove
End If
If LMax = 0 Then Exit Property
ReDim TFml(1 To LOt.ListColumns.Count)
For F = 1 To UBound(TFml)
With LOt.HeaderRowRange(2, F)
If .HasFormula Then TFml(F) = .Formula2R1C1 Else TFml(F) = Null
End With: Next F
LOt.HeaderRowRange.Offset(1).Resize(LMax).Value = TVals
For F = 1 To UBound(TFml)
If Not IsNull(TFml(F)) Then LOt.ListColumns(F).DataBodyRange.Formula2R1C1 = TFml(F)
Next F
End Property
en complément j'ai ajouté cette condition
For C = 3 To LOtR.ListColumns.Count Step 2
' Ajouter une vérification pour éviter les erreurs si le nombre de colonnes est impair
If C + 2 <= LOtR.ListColumns.Count Then
LOtR.ListColumns(C).Name = "Gén." & IIf(Descend, "+", "-") & C \ 3
LOtR.ListColumns(C + 1).Name = "Dsg. G" & IIf(Descend, "+", "-") & C \ 3
LOtR.ListColumns(C + 2).Name = "Info" & IIf(Descend, "+", "-") & C \ 3
End If
Next C
la finalité, c'est d'acquérir l'automatisme d'ajouter n champs par niveau sans pour autant tout casser.
Par avance merci pour le temps que m'avez fourni.
Cdlt