XL 2010 Majuscule & espace avec critère (Résolu)

[Kael_88]

Le Forum,

Mon problème se situe sur la forme de mon écriture dans la cellule de la Colonne D après validation,

Problème 1 :
Il faudrait qu'il transforme l'écriture de la cellule en Majuscule.

Problème 2:
Entre le premier caractère et le reste des donnée, il me faudrait un espace sauf si la donnée commence par "DEVIS", l'espace n'est plus après le premier caractère mais après le mot "DEVIS"

PS: Le tout doit se faire par macro (pas de formule et pas de MFC)
Merci

Cordialement

 

[job75]

Bonsoir Kael_88,

Fichier joint avec la macro Worksheet_Change complétée :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range, tablo, i&, x$
If FilterMode Then ShowAllData 'si la feuille est filtrée
Application.EnableEvents = False
If Target.Column = 1 And Target.Count = 1 Then
    If Cells(Target.Row, 1) <> "" Then Cells(Target.Row, 3) = Date
    If Time >= "05" Then Cells(Target.Row, 3).Interior.ColorIndex = 33
    If Time >= "13" Then Cells(Target.Row, 3).Interior.ColorIndex = 4
    If Time >= "21" Or Time < "05" Then Cells(Target.Row, 3).Interior.ColorIndex = 6
    If Target = "" Then Cells(Target.Row, 3).ClearContents: Cells(Target.Row, 3).Interior.ColorIndex = xlNone
End If
Set r = Intersect(Target, Range("D2:D" & Rows.Count), UsedRange)
If Not r Is Nothing Then
    For Each r In r.Areas 'si entrées multiples (copier-coller)
        tablo = r.Resize(, 2) 'matrice plus rapide, au moins 2 éléments
        For i = 1 To UBound(tablo)
            x = UCase(Replace(tablo(i, 1), " ", ""))
            If Left(x, 5) = "DEVIS" Then
                tablo(i, 1) = "DEVIS " & Mid(x, 6)
            ElseIf x <> "" Then
                tablo(i, 1) = Left(x, 1) & " " & Mid(x, 2)
            End If
        Next i
        r = tablo 'restitution
    Next r
End If
Application.EnableEvents = True
End Sub

Bonne nuit.

 

[Kael_88]

Le Forum,@job75,

Merci de ta réactivité, c'est parfait, comme d'habitude.

Encore merci.

Cordialement