Couleur d'onglets en dégradé [RESOLU]

Private Sub Workbook_NewSheet(ByVal Sh As Object)
Dim SheetsCount As Long
SheetsCount = Sheets.Count
Sheets(SheetsCount).Tab.ColorIndex = Sheets.Count
End Sub

Private Declare Function CHOOSECOLOR Lib "comdlg32.dll" Alias _
 "ChooseColorA" (pChoosecolor As CHOOSECOLOR) As Long
 
Private Type CHOOSECOLOR
     lStructSize As Long
     hwndOwner As Long
     hInstance As Long
     rgbResult As Long
     lpCustColors As String
     flags As Long
     lCustData As Long
     lpfnHook As Long
     lpTemplateName As String
 End Type
 
Public Function ShowColor(Handle As Long) As Long
     Dim cc As CHOOSECOLOR
     Dim Custcolor(16) As Long
     Dim lReturn As Long
     Dim CustomColors As String
 
    cc.lStructSize = Len(cc)
     cc.hwndOwner = Handle
     cc.lpCustColors = StrConv(CustomColors, vbUnicode)
     cc.flags = 0
 
    If CHOOSECOLOR(cc) <> 0 Then
         ShowColor = cc.rgbResult
         CustomColors = StrConv(cc.lpCustColors, vbFromUnicode)
     Else
         ShowColor = -1
     End If
 End Function
 
Sub test()
     Dim Couleur As Long
     Couleur = ShowColor(Application.Hwnd)
     ActiveSheet.Tab.Color = Couleur
 End Sub

Sub ColorerOnglet()
    
Dim sh, Pas, TandS, i
Pas = -2 / Sheets.Count

For i = 1 To Sheets.Count
    With Sheets(i).Tab
        .Color = RGB(195, 255, 0)
        .TintAndShade = 1 + i * Pas
    End With
Next i
End Sub