Microsoft 365 ajout de caractères dans une chaine

[Usine à gaz]

Bonjour à toutes et à tous,

J'ai besoin d'insérer des caractères à l'intérieur du contenu d'une cellule.

Ne trouvant pas le bon codage, je me tourne une nouvelle fois vers le Forum.
J'ai fait des essais et recherches sur le net et dans mes forums préférés

J'ai trouvé ce code qui fonctionne (presque bien) :

Sub Test()
Dim Var As String, VarModifié As String
Dim L As Byte, i As Byte
    Var = ActiveCell.Value
    L = Len(Var)
    For i = 1 To L - 2 Step 2
        VarModifié = VarModifié & Mid(Var, i, 2) & ":"
    Next
    ActiveCell = VarModifié & Right(Var, 2)
End Sub

Fonctionnement du code :
1 clic (sélection) sur la cellule pour ajout de caractères
2 clic sur le bouton

Dans l'exemple du fichier joint, je teste sur l'ajout d'un caractère tout les 2 caractères de la chaîne
Mon souci :
l'avant dernier caractère est doublé si caractères de la chaîne en nombre impair.

Auriez-vous la solution ?
Fichier test joint,
Avec mes remerciements,
Je vous souhaite une belle journée,
Amicalement,
lionel,

 

[Staple1600]

Bonjour le fil,

Histoire d'avoir le choix

Sub test()
Dim Chaine$
Chaine = "arthour973"
MsgBox InsChr(Chaine)
MsgBox InsChr(Chaine, ";")
MsgBox InsChr(Chaine, "/")
End Sub
Function InsChr(vText As String, Optional AddChar As String = ":") As String
Dim i%, pT$
If Len(vText) > 3 Then InsChr = vText: pT = Left(vText, 2)
For i = 3 To Len(vText) Step 2
pT = pT & AddChar & Mid(vText, i, 2)
Next i
InsChr = pT
End Function