Option Explicit
Sub TableauParoi() ' Le blanc souligné est à réserver aux noms des procédures évènements
' comme séparateur entre le nom de l'objet et le nom de l'évènement.
Dim TE(), LE&, TS(), LS&, TR(), LR&, C&, Nom As String, Rng As Range, LTot&
TE = Feuil1.ListObjects(1).Range.Value
ReDim TS(1 To 1000, 1 To 5)
For LE = 2 To UBound(TE, 1)
If Not IsEmpty(TE(LE, 2)) Then
LS = LS + 1
TS(LS, 1) = TE(LE, 1)
TS(LS, 2) = TE(LE, 2): End If
If Not IsEmpty(TE(LE, 3)) Then TS(LS, 3) = TE(LE, 3) * 100
If Not IsEmpty(TE(LE, 4)) Then TS(LS, 4) = TE(LE, 4)
If Not IsEmpty(TE(LE, 5)) Then TS(LS, 5) = TE(LE, 5)
Next LE
'ReDim TR(1 To 1000, 1 To 25)
ReDim TR(1 To UBound(TE, 1), 1 To 25)
InitialiserMiseEnPage Feuil2.[C134], 39, 5
LS = 1
Do: Nom = TS(LS, 1): TR(1, 1) = UCase(Nom)
LR = 3: For C = 1 To 4
TR(LR, Choose(C, 1, 23, 24, 25)) = Choose(C, "Fruit", "épaisseur (cm)", "Chiffre", "Clé")
Next C
Do: LR = LR + 1
For C = 1 To 4
TR(LR, Choose(C, 1, 23, 24, 25)) = TS(LS, C + 1)
Next C
LS = LS + 1: Loop Until TS(LS, 1) <> Nom
Set Rng = PlageSuivante(TR, LR)
LTot = Rng.Rows.Count + 1
With Rng(LTot, 20)
.Value = " TOTAL"
.Font.Bold = True
End With
Rng(LTot, 20).Resize(, 3).BorderAround ColorIndex:=16
Rng(LTot, 23).FormulaR1C1 = "=SUM(R[-" & LTot - 4 & "]C:R[-1]C)"
Rng(LTot, 24).FormulaR1C1 = "=SUM(R[-" & LTot - 4 & "]C:R[-1]C)"
Rng(LTot, 25).FormulaR1C1 = "=SUM(R[-" & LTot - 4 & "]C:R[-1]C)"
With Rng(2, 1).Resize(2, 22)
.MergeCells = True
End With
With Rng(2, 23).Resize(2)
.MergeCells = True
.HorizontalAlignment = xlCenter
End With
With Rng(2, 24).Resize(2)
.MergeCells = True
.HorizontalAlignment = xlCenter
End With
With Rng(2, 25).Resize(2)
.MergeCells = True
.HorizontalAlignment = xlCenter
End With
With Rng.Rows(2).Resize(2)
'.RowHeight = 30
.Interior.Color = RGB(186, 255, 186)
.VerticalAlignment = xlCenter
.BorderAround ColorIndex:=16
End With
Rng(LTot, 20).Resize(, 3).Interior.Color = RGB(186, 255, 186)
With Rng(3, 23).Resize(LTot - 2, 3)
.NumberFormat = "0.00"
.HorizontalAlignment = xlCenter
End With
Rng.Rows(4).Resize(LTot - 4).BorderAround ColorIndex:=16
Rng(4, 22).Resize(LTot - 4, 4).Borders(xlInsideVertical).ColorIndex = 16
Rng(LTot, 23).Resize(, 3).BorderAround ColorIndex:=16
Rng(1, 1).Font.Bold = True
Loop Until IsEmpty(TS(LS, 1))
'ReDim TR(1 To UBound(TE, 1), 1 To 25)
TE = Feuil3.ListObjects(1).Range.Value
LE = 1
Do:
TR(1, 1) = UCase("Liste des outils")
LR = 5: For C = 1 To 4
TR(LR, Choose(C, 1, 21, 24, 25)) = Choose(C, "Outil", "position", "taille", "couleur")
Next C
Do: LR = LR + 1
For C = 1 To 4
TR(LR, Choose(C, 1, 21, 24, 25)) = TE(LE, C)
Next C
LE = LE + 1: Loop Until LE > UBound(TE, 1)
Set Rng = PlageSuivante(TR, LR)
LTot = Rng.Rows.Count + 1
With Rng(4, 1).Resize(2, 18)
.MergeCells = True
End With
With Rng(4, 19).Resize(2, 5)
.MergeCells = True
.HorizontalAlignment = xlCenter
End With
With Rng(4, 24).Resize(2)
.MergeCells = True
.HorizontalAlignment = xlCenter
End With
With Rng(4, 25).Resize(2)
.MergeCells = True
.HorizontalAlignment = xlCenter
End With
With Rng.Rows(4).Resize(2)
.Interior.Color = RGB(186, 255, 186)
.VerticalAlignment = xlCenter
.BorderAround ColorIndex:=16
End With
With Rng(6, 19).Resize(LTot - 2, 7)
.NumberFormat = "0.00"
.HorizontalAlignment = xlCenter
End With
Rng.Rows(4).Resize(LTot - 4).BorderAround ColorIndex:=16
Rng(6, 24).Resize(LTot - 6, 2).Borders(xlInsideVertical).ColorIndex = 16
Rng(6, 19).Resize(LTot - 6, 5).BorderAround ColorIndex:=16
With Rng(1, 1)
.Font.Bold = True
.Font.Color = RGB(20, 127, 127)
End With
Loop Until UBound(TE, 1)
TerminerMiseEnPage
'Call TableauOutil
End Sub