'----------------------------------------------------------------------
'Valorise une table des valeurs d'un Range multi-Areas ce qui peut être
'le cas d'un Range filtré obtenu avec .SpecialCells(xlCellTypeVisible)
'----------------------------------------------------------------------
Function ValuesOfMultiAreaRange(MultiAreaRange As Range) As Variant
Dim Area As Range
Dim TabCellVal(1 To 1, 1 To 1) As Variant
Dim TabAreaVal() As Variant
Dim TabVal() As Variant
Dim MaxDim2 As Integer
Dim NbVal As Long
Dim iArea As Long
Dim i As Long
Dim j As Long
If MultiAreaRange Is Nothing Then GoTo ExitFunction
'Table des valeurs des Areas
ReDim TabAreaVal(1 To MultiAreaRange.Areas.Count)
'Chargement des valeurs des Areas dans la Table des valeurs des Areas
For iArea = 1 To MultiAreaRange.Areas.Count
If MultiAreaRange.Areas(iArea).Cells.Count = 1 Then
TabCellVal(1, 1) = MultiAreaRange.Areas(iArea).Cells(1, 1).Value
TabAreaVal(iArea) = TabCellVal
Else
TabAreaVal(iArea) = MultiAreaRange.Areas(iArea).Value
End If
NbVal = NbVal + UBound(TabAreaVal(iArea), 1)
If UBound(TabAreaVal(iArea), 2) > MaxDim2 Then MaxDim2 = UBound(TabAreaVal(iArea), 2)
Next iArea
'Tableau des valeurs de toutes les Areas
ReDim TabVal(1 To NbVal, 1 To MaxDim2)
NbVal = 0
'Copie des valeurs des Areas dans le Tableau des valeurs de toutes les Areas
For iArea = 1 To MultiAreaRange.Areas.Count
For i = 1 To UBound(TabAreaVal(iArea), 1)
For j = 1 To UBound(TabAreaVal(iArea), 2)
TabVal(NbVal + i, j) = TabAreaVal(iArea)(i, j)
Next j
Next i
NbVal = NbVal + UBound(TabAreaVal(iArea), 1)
Next iArea
ExitFunction:
ValuesOfMultiAreaRange = TabVal
End Function
.
