Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim val1 As Currency
Dim val1n As String
Dim i As Integer
Dim li As Byte
If Target = "" Then Exit Sub
If Target.Offset(1, 0).Value = "" Then
li = Len(Target)
For i = 1 To li
If IsNumeric(Mid(Target, i, 1)) Then Exit For
Next i
li = li - (i - 1) ' nb de chiffres
val1 = CCur(Replace(Target, Left(Target, i - 1), "") + 1)
Select Case Len(CStr(val1))
Case li
val1n = CStr(Mid(Target, 1, i - 1) & val1)
Case Is > li
Select Case MsgBox("Le code qui va être écrit n'a pas le même nombre de carractère" _
& vbCrLf & "Ancien code :" & Target _
& vbCrLf & "Nouveau code :" & Mid(Target, 1, i - 1) & val1 _
& vbCrLf & "" _
, vbOKCancel Or vbInformation Or vbDefaultButton1, Application.Name)
Case vbOK
val1n = CStr(Mid(Target, 1, i - 1) & val1)
Case vbCancel
Exit Sub
End Select
Case Is < li
val1n = CStr(Mid(Target, 1, i - 1) & String(li - Len(CStr(val1)), "0") & val1)
End Select
Target.Offset(1, 0).Value = val1n
' reproduire la mise en forme
Target.Copy
Target.Offset(1, 0).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End If
End Sub