' V0.3.3
Sub ATransposeTable()
    Dim margeGauche As Integer
    Dim margeHaut As Integer
    Dim ecartMatricesGenerees
    Dim ecart12 As Integer
    Dim ecartMoyenneMediane As Integer
    Dim espaceTitreTableau As Integer
    Dim ecartEchelle As Integer
    Dim selectedRange As Range
    Set selectedRange = selection
    
    ' //////////Réglage des écartements :\\\\\\\\\\
    ' Marge générale à gauche
    margeGauche = 1
    ' Marge générale en haut
    margeHaut = 1
    ' Ecartement horizontal des matrices renversées
    ecartMatricesGenerees = 2
    ' Ecart horizontal entre les matrices avec et sans chiffres
    ecart12 = 1
    'Ecart horizontal entre les blocs Mediane et Moyenne
    ecartMoyenneMediane = 6
    ' Marge verticale des séries de matrices
    espaceTitreTableau = 3
    ' Marge horizontale entre matrice invisible et échelle
    ecartEchelle = 1
    
    ' //////////Enregistrement des références :\\\\\\\\\\
    Dim firstRowSize As Integer
    Dim indexFirstRow As Integer
    Dim indexLastRow As Integer
    
    Dim firstColSize As Integer
    Dim indexFirstCol As Integer
    Dim indexLastCol As Integer
    
    firstRowSize = selectedRange.Rows.Count
    indexFirstRow = selectedRange.Cells(0, 0).Row + 1
    indexLastRow = indexFirstRow + firstRowSize
    firstColSize = selectedRange.Columns.Count
    indexFirstCol = selectedRange.Cells(0, 0).Column + 1
    indexLastCol = indexFirstCol + firstColSize
    
    
    ' //////////Renversement des matrices :\\\\\\\\\\
    
    ' Remplace les cases vides par NaN dans la matrice initiale
    Dim cell As Range
    For Each cell In selectedRange
        If cell.Value = "" Then
            cell.Value = "NaN"
        End If
    Next cell
    
    ' Transpose la plage de données sélectionnée
    Dim transposedRange As Range
    Set transposedRange = ActiveSheet.Cells(indexFirstRow, indexLastCol + ecartMatricesGenerees).Resize(firstColSize, firstRowSize)
    ' Boucle à travers les cellules de la plage originale
    For i = 1 To firstRowSize
        For j = 1 To firstColSize
            ' Copiez la valeur de la cellule originale dans la cellule transposée correspondante
            transposedRange.Cells(j, i).Value = selectedRange.Cells(i, j).Value
        Next j
    Next i
    
    ' Inverser l'ordre des lignes
    Dim invertedRange As Range
    Set invertedRange = transposedRange.Offset(0, firstRowSize + ecartMatricesGenerees)
    For i = 1 To transposedRange.Rows.Count
        For j = 1 To transposedRange.Columns.Count
                invertedRange.Cells(i, j).Value = transposedRange.Cells(transposedRange.Rows.Count + 1 - i, j).Value
        Next j
    Next i
    
    
    ' //////////Création des matrices de présentation :\\\\\\\\\\
    
    ' Détermine où commencer les matrices selon les dimensions de la map
    Dim rowSize As Integer
    Dim colSize As Integer
    Dim indexFirstPresRow As Integer
    rowSize = firstColSize
    colSize = firstRowSize
    If firstColSize > firstRowSize Then
        indexFirstPresRow = margeHaut + firstColSize + espaceTitreTableau + 1
    Else
        indexFirstPresRow = margeHaut + firstRowSize + espaceTitreTableau + 1
    End If
    Dim scaleColSize As Integer
    scaleColSize = 2

    ' Valeurs brutes
    Dim bruteMediane1 As Range
    Set bruteMediane1 = ActiveSheet.Cells(indexFirstPresRow, indexFirstCol).Resize(rowSize, colSize)
    bruteMediane1.BorderAround _
        ColorIndex:=xlAutomatic, Weight:=xlThin
    For i = 1 To rowSize
        For j = 1 To colSize
                bruteMediane1.Cells(i, j).Value = invertedRange.Cells(i, j).Value
                bruteMediane1.Cells(i, j).HorizontalAlignment = xlCenter
                bruteMediane1.Cells(i, j).VerticalAlignment = xlCenter
        Next j
    Next i
    
    
    Dim bruteMediane2 As Range
    Set bruteMediane2 = bruteMediane1.Offset(0, colSize + ecart12)
    bruteMediane2.BorderAround _
        ColorIndex:=xlAutomatic, Weight:=xlThin
    For i = 1 To rowSize
        For j = 1 To colSize
                bruteMediane2.Cells(i, j).Value = invertedRange.Cells(i, j).Value
                bruteMediane2.Cells(i, j).HorizontalAlignment = xlCenter
                bruteMediane2.Cells(i, j).VerticalAlignment = xlCenter
                bruteMediane2.Cells(i, j).NumberFormat = ";;;"
        Next j
        bruteMediane2.Cells(i, j + ecartEchelle).NumberFormat = ";;;"
    Next i
    Dim zoneEchelleBruteMediane As Range
    Set zoneEchelleBruteMediane = ActiveSheet.Cells(indexFirstPresRow + 1, indexFirstCol + colSize + ecart12 + colSize + 1 + 1).Resize(rowSize, scaleColSize)
    Call GenererEchelle(zoneEchelleBruteMediane)
    Dim zoneAColorer As Range
    Set zoneAColorer = ActiveSheet.Cells(indexFirstPresRow, indexFirstCol).Resize(rowSize, colSize + ecart12 + colSize + ecartEchelle + 1)
    Call ColorerMatrices(zoneAColorer, "med")
    
    Dim bruteMoyenne1 As Range
    Set bruteMoyenne1 = bruteMediane2.Offset(0, colSize + ecartMoyenneMediane)
    bruteMoyenne1.BorderAround _
        ColorIndex:=xlAutomatic, Weight:=xlThin
    For i = 1 To rowSize
        For j = 1 To colSize
                bruteMoyenne1.Cells(i, j).Value = invertedRange.Cells(i, j).Value
                bruteMoyenne1.Cells(i, j).HorizontalAlignment = xlCenter
                bruteMoyenne1.Cells(i, j).VerticalAlignment = xlCenter
                
        Next j
    Next i
    
    Dim bruteMoyenne2 As Range
    Set bruteMoyenne2 = bruteMoyenne1.Offset(0, colSize + ecart12)
    bruteMoyenne2.BorderAround _
        ColorIndex:=xlAutomatic, Weight:=xlThin
    For i = 1 To rowSize
        For j = 1 To colSize
                bruteMoyenne2.Cells(i, j).Value = invertedRange.Cells(i, j).Value
                bruteMoyenne2.Cells(i, j).HorizontalAlignment = xlCenter
                bruteMoyenne2.Cells(i, j).VerticalAlignment = xlCenter
                bruteMoyenne2.Cells(i, j).NumberFormat = ";;;"
                
        Next j
        bruteMoyenne2.Cells(i, j + ecartEchelle).NumberFormat = ";;;"
    Next i
    Dim zoneEchelleBruteMoyenne As Range
    Set zoneEchelleBruteMoyenne = ActiveSheet.Cells(indexFirstPresRow + 1, indexFirstCol + colSize + ecart12 + colSize + ecartMoyenneMediane + colSize + ecart12 + colSize + 1 + 1).Resize(rowSize, scaleColSize)
    Call GenererEchelle(zoneEchelleBruteMoyenne)
    Call ColorerMatrices(zoneAColorer.Offset(0, colSize + ecart12 + colSize + ecartMoyenneMediane), "moy")
    
    ' Valeurs modifiées
    Dim reponse As Integer
    reponse = MsgBox("Ecraser les matrices modifiées ?", vbYesNo)
    If reponse = vbYes Then
        Dim modifMediane1 As Range
        Set modifMediane1 = bruteMediane1.Offset(rowSize + espaceTitreTableau, 0)
        modifMediane1.BorderAround _
        ColorIndex:=xlAutomatic, Weight:=xlThin
        For i = 1 To rowSize
            For j = 1 To colSize
                    modifMediane1.Cells(i, j).Value = invertedRange.Cells(i, j).Value
                    modifMediane1.Cells(i, j).HorizontalAlignment = xlCenter
                    modifMediane1.Cells(i, j).VerticalAlignment = xlCenter
            Next j
        Next i
        
        Dim modifMediane2 As Range
        Set modifMediane2 = bruteMediane2.Offset(rowSize + espaceTitreTableau, 0)
        modifMediane2.BorderAround _
        ColorIndex:=xlAutomatic, Weight:=xlThin
        For i = 1 To rowSize
            For j = 1 To colSize
                    modifMediane2.Cells(i, j).Value = invertedRange.Cells(i, j).Value
                    modifMediane2.Cells(i, j).HorizontalAlignment = xlCenter
                    modifMediane2.Cells(i, j).VerticalAlignment = xlCenter
                    modifMediane2.Cells(i, j).NumberFormat = ";;;"
            Next j
            modifMediane2.Cells(i, j + ecartEchelle).NumberFormat = ";;;"
        Next i
        Call GenererEchelle(zoneEchelleBruteMediane.Offset(rowSize + espaceTitreTableau, 0))
        Call ColorerMatrices(zoneAColorer.Offset(rowSize + espaceTitreTableau, 0), "med")
        
        Dim modifMoyenne1 As Range
        Set modifMoyenne1 = bruteMoyenne1.Offset(rowSize + espaceTitreTableau, 0)
        modifMoyenne1.BorderAround _
        ColorIndex:=xlAutomatic, Weight:=xlThin
        For i = 1 To rowSize
            For j = 1 To colSize
                    modifMoyenne1.Cells(i, j).Value = invertedRange.Cells(i, j).Value
                    modifMoyenne1.Cells(i, j).HorizontalAlignment = xlCenter
                    modifMoyenne1.Cells(i, j).VerticalAlignment = xlCenter
            Next j
        Next i
        
        Dim modifMoyenne2 As Range
        Set modifMoyenne2 = bruteMoyenne2.Offset(rowSize + espaceTitreTableau, 0)
        modifMoyenne2.BorderAround _
        ColorIndex:=xlAutomatic, Weight:=xlThin
        For i = 1 To rowSize
            For j = 1 To colSize
                    modifMoyenne2.Cells(i, j).Value = invertedRange.Cells(i, j).Value
                    modifMoyenne2.Cells(i, j).HorizontalAlignment = xlCenter
                    modifMoyenne2.Cells(i, j).VerticalAlignment = xlCenter
                    modifMoyenne2.Cells(i, j).NumberFormat = ";;;"
            Next j
            modifMoyenne2.Cells(i, j + ecartEchelle).NumberFormat = ";;;"
        Next i
        Call GenererEchelle(zoneEchelleBruteMoyenne.Offset(rowSize + espaceTitreTableau, 0))
        Call ColorerMatrices(zoneAColorer.Offset(rowSize + espaceTitreTableau, colSize + ecart12 + colSize + ecartMoyenneMediane), "moy")
    End If
    
End Sub

Sub ExtraireValeurs()
    'Déclaration des variables
    Dim selectedRange As Range
    Set selectedRange = selection
    Dim cell As Range

    Dim ecriture As Range
    Set ecriture = Application.InputBox("Selectionne la case d'écriture", Type:=8)
    'Parcourir chaque cellule dans la sélection
    Dim i As Integer
    i = ecriture.Row
    For Each cell In selectedRange
        'Copier la valeur de la cellule dans la colonne I à partir de l'adresse I65
        Cells(i, ecriture.Column).Value = cell.Value
        i = i + 1
    Next cell
End Sub

Sub GenererEchelle(zoneEchelle As Range)
    Dim maxEchelle As Integer
    Dim minEchelle As Integer
    Dim pasEchelle As Integer
    Select Case Left(ActiveSheet.Name, 1)
        Case "s", "S"
            maxEchelle = 3000
            minEchelle = 200
            pasEchelle = 200
        Case "y", "Y"
            maxEchelle = 1000
            minEchelle = 0
            pasEchelle = 100
        Case "l", "L"
            maxEchelle = 1600
            minEchelle = 100
            pasEchelle = 100
        Case Else
            MsgBox "Le nom de l'onglet ne commence pas par 's', 'y' ou 'l'."
    End Select
    Dim echelleRowSize As Integer
    echelleRowSize = (maxEchelle - minEchelle) / pasEchelle + 1
    
    Dim echelleCouleurs As Range
    Set echelleCouleurs = zoneEchelle.Cells(0, 0).Resize(echelleRowSize, 1)
    
    echelleCouleurs.Borders(xlDiagonalDown).LineStyle = xlNone
    echelleCouleurs.Borders(xlDiagonalUp).LineStyle = xlNone
    With echelleCouleurs.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With echelleCouleurs.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With echelleCouleurs.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With echelleCouleurs.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    echelleCouleurs.Borders(xlInsideVertical).LineStyle = xlNone
    echelleCouleurs.Borders(xlInsideHorizontal).LineStyle = xlNone
    
    Dim cell As Range
    For Each cell In echelleCouleurs
        cell.Formula = "=" + cell.Offset(0, 1).Address
    Next cell
    
    
    Dim echelleValeurs As Range
    Set echelleValeurs = zoneEchelle.Cells(0, 1).Resize(echelleRowSize, 1)
    With echelleValeurs.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With echelleValeurs.Font
        .Name = "Calibri"
        .Size = 14
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    With echelleValeurs
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With echelleValeurs
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Dim currentEchelle As Integer
    currentEchelle = maxEchelle
    For Each cell In echelleValeurs
        cell.Value = currentEchelle
        currentEchelle = currentEchelle - pasEchelle
    Next cell
    
End Sub

Sub ColorerMatrices(zoneAColorer As Range, medMoy As String)
    Dim monType As XlConditionValueTypes
    If medMoy = "med" Then
        monType = xlConditionValuePercentile
    ElseIf medMoy = "moy" Then
        monType = xlConditionValuePercent
    End If
    
    Dim themeColor1 As XlThemeColor
    Dim themeColor2 As XlThemeColor
    Dim themeColor3 As XlThemeColor
    Dim tintShade1 As Double
    Dim tintShade2 As Double
    Dim tintShade3 As Double
    
    Select Case Left(ActiveSheet.Name, 1)
        Case "s", "S"
            themeColor1 = xlThemeColorAccent1
            themeColor2 = xlThemeColorAccent4
            themeColor3 = xlThemeColorAccent2
            tintShade1 = 0.399975585192419
            tintShade2 = 0.799981688894314
            tintShade3 = 0
        Case "y", "Y"
            themeColor1 = 10066176
            themeColor2 = xlThemeColorAccent4
            themeColor3 = 13260
            tintShade1 = 0
            tintShade2 = 0.599993896298105
            tintShade3 = 0
        Case "l", "L"
            themeColor1 = xlThemeColorDark1
            themeColor2 = xlThemeColorAccent4
            themeColor3 = xlThemeColorAccent2
            tintShade1 = -0.499984740745262
            tintShade2 = 0.799981688894314
            tintShade3 = 0
        Case Else
            MsgBox "Le nom de l'onglet ne commence pas par 's', 'y' ou 'l'."
    End Select
    
    zoneAColorer.FormatConditions.AddColorScale ColorScaleType:=3
    zoneAColorer.FormatConditions(zoneAColorer.FormatConditions.Count).SetFirstPriority
    zoneAColorer.FormatConditions(1).colorScaleCriteria(1).Type = _
        xlConditionValueLowestValue
    Select Case Left(ActiveSheet.Name, 1)
        Case "s", "S", "l", "L"
            With zoneAColorer.FormatConditions(1).colorScaleCriteria(1).FormatColor
                .ThemeColor = themeColor1
                .TintAndShade = tintShade1
            End With
            zoneAColorer.FormatConditions(1).colorScaleCriteria(2).Type = _
                monType
            zoneAColorer.FormatConditions(1).colorScaleCriteria(2).Value = 50
            With zoneAColorer.FormatConditions(1).colorScaleCriteria(2).FormatColor
                .ThemeColor = themeColor2
                .TintAndShade = tintShade2
            End With
            zoneAColorer.FormatConditions(1).colorScaleCriteria(3).Type = _
                xlConditionValueHighestValue
            With zoneAColorer.FormatConditions(1).colorScaleCriteria(3).FormatColor
                .ThemeColor = themeColor3
                .TintAndShade = tintShade3
            End With
        Case "y", "Y"
            With zoneAColorer.FormatConditions(1).colorScaleCriteria(1).FormatColor
                    .Color = themeColor1
                    .TintAndShade = tintShade1
                End With
                zoneAColorer.FormatConditions(1).colorScaleCriteria(2).Type = _
                    monType
                zoneAColorer.FormatConditions(1).colorScaleCriteria(2).Value = 50
                With zoneAColorer.FormatConditions(1).colorScaleCriteria(2).FormatColor
                    .ThemeColor = themeColor2
                    .TintAndShade = tintShade2
                End With
                zoneAColorer.FormatConditions(1).colorScaleCriteria(3).Type = _
                    xlConditionValueHighestValue
                With zoneAColorer.FormatConditions(1).colorScaleCriteria(3).FormatColor
                    .Color = themeColor3
                    .TintAndShade = tintShade3
                End With
    End Select
End Sub


' //////////Changelog :\\\\\\\\\\
' V0.2 : Encadre les matrices de présentation
' V0.2.1 : Centre verticalement les valeurs des matrices de presentation
' V0.3 : Nettoyage du code de placement des matrices de présentation; Ajout des échelles et coloration des matrices
' V0.3.1 : Gère la coloration différenciée entre médiane et moyenne; Gere des couleurs différentes selon que l'onglet commence par "l" ou par "s"
' V0.3.2 : Gère la coloration pour l'onglet "y"
' V0.3.3 : Change min max et pas sur l'échelle selon onglet