[Excel] Vba_creation de code

Option Explicit

Sub location()
Dim Feuille As Worksheet, Country As String, Location_code As String
Dim NoCol As Integer, exception As Integer

    Const strRANGECOUNTRY As String = "B1:F1"       'A ADAPTER
    Const MSG_ANNULE As String = "Abort..."         'A ADAPTER
    Set Feuille = Worksheets("Feuil1")              'A ADAPTER
    
    Country = Funct_MyInputBox(Feuille, strRANGECOUNTRY, True, MSG_ANNULE)
    If Country = MSG_ANNULE Then Exit Sub
    
    NoCol = Funct_Numero_Colonne(Feuille, 1, Country)
    If NoCol = 0 Then MsgBox "This country doesn't exists on the ActiveSheet's first line": Exit Sub

    'Pour verifier les exceptions
    'etc...
End Sub

Private Function Funct_MyInputBox(Wsh As Worksheet, rngValues As String, Optional ForceMajuscules As Boolean, Optional strMessage As String) As String
'Fonction utilisant l'inputbox.
    'clic sur OK sans saisie ==> relance l'inputbox
    'clic sur annuler ==> retourne le message d'annulation
    'mauvaise saisie ==> relance l'inputbox
'PARAMETRES :
    'Wsh (Worksheet): Feuille ou sont situées les données permettant la vérification de la saisie
    'rngValues (String) : l'adresse du Range ou sont situées les données (soit sur 1 ligne, soit sur 1 colonne)
    'ForceMajuscules (Boolean) : si True transforme les saisies en Majuscules
    'strMessage (String / Optional) : le message d'abandon par l'utilisateur
'ATTENTION : utilise la fonction Funct_Dimension

Dim bon As Boolean, entree As String, MyArray As Variant, i As Long, Dimens As Byte, Valeur As String

    MyArray = Wsh.Range(rngValues).Value
    If UBound(MyArray, 1) > 1 And UBound(MyArray, 2) > 1 Then
        MsgBox "Plage non valide (toléré : 1 ligne ou 1 colonne)"
        Funct_MyInputBox = strMessage: Exit Function
    End If
    Dimens = Funct_Dimension(MyArray)
    Do While Not bon
        entree = InputBox("Enter your Country code", "Country code")
        If StrPtr(entree) = 0 Then Funct_MyInputBox = strMessage: Exit Function ' -->> on a annulé
        If entree <> "" Then
            entree = IIf(ForceMajuscules, UCase(entree), entree)
            If Dimens = 1 Then
                For i = LBound(MyArray, Dimens) To UBound(MyArray, Dimens)
                    Valeur = IIf(ForceMajuscules, UCase(MyArray(i, 1)), MyArray(i, 1))
                    If Valeur = entree Then
                        bon = True: Exit For
                    End If
                Next i
            Else
                For i = LBound(MyArray, Dimens) To UBound(MyArray, Dimens)
                    Valeur = IIf(ForceMajuscules, UCase(MyArray(1, i)), MyArray(1, i))
                    If Valeur = entree Then
                        bon = True: Exit For
                    End If
                Next i
            End If
        End If
    Loop
    Funct_MyInputBox = IIf(ForceMajuscules, UCase(entree), entree)
End Function

Private Function Funct_Dimension(Arr As Variant) As Byte
'retourne la dimension la plus grande de l'Array Arr
'si pas de "plus grande" dimension retourne 1 par défaut
    Select Case True
        Case UBound(Arr, 1) > UBound(Arr, 2)
            Funct_Dimension = 1
        Case UBound(Arr, 2) > UBound(Arr, 1)
            Funct_Dimension = 2
        Case Else
            Funct_Dimension = 1
    End Select
End Function


Private Function Funct_Numero_Colonne(Wsh As Worksheet, Ligne As Long, strVal As String) As Integer
'Retourne le numéro de la colonne à partir des paramètres :
    'Wsh : feuille ou chercher
    'Ligne : Ligne ou chercher
    'strVal : Valeur à chercher
Dim Rng As Range

    Set Rng = Wsh.Rows(Ligne).Cells.Find(strVal)
    If Not Rng Is Nothing Then
        Funct_Numero_Colonne = Rng.Column
    Else
        Funct_Numero_Colonne = 0
    End If
End Function

'Pour récupérer le no de colonne
Do Until Cells(1, NoCol).Value = Country
    NoCol = NoCol + 1
Loop