Sub GenererNumBC()
Dim tmp() As String, numBC As String, laCell As Range, laZone As Range, memA As String, max As Long
'numBC représente le numéro du bon de commande à générer
'on l'initialise avec le numéro de l'année + <espace> + le numéro du mois + <espace>
numBC = CStr(Year(Now)) & " " & CStr(Month(Now)) & " "
'on récupère dans un tableau chaque mot composant le service (cellule C4 du formulaire)
tmp = Strings.Split(ThisWorkbook.Sheets("Formulaire services généraux").Range("C4").Text, " ")
'si le service (C4) est composé d'un seul mot rajouter à numBC les 2 premières lettres du service en majuscule (+ <espace>)
'sinon, rajouter à numBC la première lettre des 2 premiers mots en majuscule (+ <espace>)
If LBound(tmp) = UBound(tmp) Then numBC = numBC & UCase(Left(tmp(0), 2)) & " " Else numBC = numBC & UCase(Left(tmp(0), 1)) & UCase(Left(tmp(1), 1)) & " "
'à ce niveau, numBC est de la forme "aaaa mm XX " (ici "2010 10 SG ")
'définir la zone du "Tableau Récapitulatif" contenant les références déjà inscrites (colonne A)
With ThisWorkbook.Sheets("Tableau Récapitulatif")
Set laZone = .Range("A3:A" & .Range("A" & .Rows.Count).End(xlUp).Row)
End With
'rechercher dans laZone la première cellule commançant par numBC
Set laCell = laZone.Find(numBC, , xlValues, xlPart)
'si aucune cellule n'est trouvée (aucune référence déjà saisie ne commence par numBC)
'ici, il s'agit donc de la première référence commençant par "2010 10 SG "
If laCell Is Nothing Then
'ajouter "01" à numBC
numBC = numBC & "01"
'sinon
Else
'boucler sur toutes les cellules commençant par numBC
memA = laCell.Address
Do
'max représente une "mémoire" qui va contenir le numéro de la dernière référence commençant par numBC
'si le numéro de la référence est supérieur à max, max = le numéro de la référence
If CLng(Replace(laCell.Text, numBC, "")) > max Then max = CLng(Replace(laCell.Text, numBC, ""))
Set laCell = laZone.FindNext(laCell)
Loop Until laCell.Address = memA
'ajouter à numBC "max+1"
numBC = numBC & Format(max + 1, "00")
End If
'écrire numBC dans le formulaire en F2
ThisWorkbook.Sheets("Formulaire services généraux").Range("F2").Value = numBC
End Sub