Modifier le format des données entrée en minuscule

Le 10/03/2021 à 09:02

Bonjour

je fais des relevés de la généalogie en fonction d'un tableau prédéfini par les archives. Les archives demandent un certains formalisme pour intégrer le fichier dans leur base de donnée. Genre les nom en Majuscule et la 1ère lettre du prénom en majuscule. Pour me simplifier la saisie, je recherche à entrée les données en minuscule pour m'éviter de changer le type de saisie. C'est 3GB qui m'a donné une solution en macro. J'entre les données en minuscules et la macro les transforment :

- en majuscules pour les colonnes rouges

- 1ère lettre en majuscule pour les autres en bleu.

Nota : les colonnes 18 et 29 ne sont pas mis en rouge car je recopie en faisant =

11mariages-essai.zip (31.34 Ko)

Pouvez-vous m'aider ?

Cordialement

Le 10/03/2021 à 09:27

Bonjour,

Une proposition.

Cdlt.

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo errHandler
    If Target.Row > 4 And Target.CountLarge = 1 Then
        Application.EnableEvents = False
        Select Case Target.Column
            Case 9, 11, 16, 18, 24, 29, 33:
                Target.Value = VBA.UCase(Target.Value)
            Case 10, 12, 15, 17, 19, 25, 27, 30, 32, 34:
                Target.Value = WorksheetFunction.Proper(Target.Value)
            Case Else:
        End Select
    End If
exitHandler:
    Application.EnableEvents = True
    Exit Sub
errHandler:
    MsgBox "Erreur : " & Err.Number & Chr(10) & Err.Description
    Resume exitHandler
End Sub
Le 10/03/2021 à 09:28

Bonjour Jag, 3GB, bonjour le forum,

J'ai remplacé le code du composant Feuil1 (SAISIE), par celui-ci :

Private Sub Worksheet_Change(ByVal Target As Range)
Set rnom = Intersect(Target, Application.Union(Columns(9), Columns(16), Columns(18), Columns(24), Columns(29), Columns(33)))
Set rprenom = Intersect(Target, Application.Union(Columns(10), Columns(12), Columns(15), Columns(17), Columns(19), Columns(25), Columns(27), Columns(30), Columns(32), Columns(34)))
Application.EnableEvents = False
If Not rnom Is Nothing Then
    For Each cell In rnom
        If cell.Value <> "" Then cell.Value = UCase(cell.Value)
    Next cell
End If
If Not rprenom Is Nothing Then
    For Each cell In rprenom
        If cell.Value <> "" Then cell.Value = Application.Proper(cell.Value)
    Next cell
End If
Application.EnableEvents = True
End Sub
4mariages-essai.zip (34.15 Ko)

[Édition]

Bonjour Jean-Éric, nos posts se sont croisés...

Le 10/03/2021 à 09:29

Bonjour toutes et tous

EDIT oups Jean-Eric: coucou Eric^^ et Thauthème ^^

@Jag8308, un début de réponse @tester

pour les MAJuscules le code pour colonnes (rouge) @tester, je pense que l'on peut simplifier également

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Or Target.Value = "" Then Exit Sub
    Application.EnableEvents = False
    If Not Intersect(Target, Columns("I")) Is Nothing Then
    Target = UCase(Target)
    End If

    If Not Intersect(Target, Columns("P")) Is Nothing Then
    Target = UCase(Target)
    End If

    If Not Intersect(Target, Columns("R")) Is Nothing Then
    Target = UCase(Target)
    End If

    If Not Intersect(Target, Columns("X")) Is Nothing Then
    Target = UCase(Target)
    End If

    If Not Intersect(Target, Columns("AC")) Is Nothing Then
    Target = UCase(Target)
    End If

    If Not Intersect(Target, Columns("AG")) Is Nothing Then
    Target = UCase(Target)
    End If

    Application.EnableEvents = True

End Sub

j'pense que l'on peut simplifier mais je doute que cela comme cela fonctionne ci-dessous:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Or Target.Value = "" Then Exit Sub
    Application.EnableEvents = False
 If Not Intersect(Target, Columns("I","P","R","X","AC","AG","AG")) Is Nothing Then
    Target = UCase(Target)
    End If
Application.EnableEvents = True

End Sub

crdlt,

André

Le 10/03/2021 à 09:42

Re

Je viens de voir l'ensemble des solutions. Laisser moi un peu de temps pour toutes les tester et je reviens vers vous.

Merci

Cordialement

Le 10/03/2021 à 12:10

Re

j'ai testé toutes les macros que vous avez développées, elles fonctionnent toutes, sauf la simplification de Andre 13 qui bug.

Novice en la matière, j'ai installé celle de André car j'ai les lettres à changer pour mes autres tableaux (décès et naissances) qui sont différents sur les colonnes à remplir. Alors pour André 13 pouvez ajouter le reste pour prendre en compte les 1ére lettre en majuscule.

Je vous remercie tous pour le travail et vous en remercie énormément.

Cordialement.

Le 10/03/2021 à 12:34

Re,

Et moi, et moi !?

Cdlt.

Le 10/03/2021 à 14:39

Re,

@Jag8308, ===>les meilleurs codées sont celles de Thauthème et de Jean-Eric<===

désolé Jean-Eric j'ai mis en erreur Jag8308 pour ton pseudonyme

@Jag8308, voici aussi non, note j'ai une version Excel 2016 Fr, c'est peut être pour cela le bug:

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
' MAJUSCULE
If Target.Count > 1 Or Target.Value = "" Then Exit Sub
    Application.EnableEvents = False
    If Not Intersect(Target, Columns("I")) Is Nothing Then
    Target = UCase(Target)
    End If

    If Not Intersect(Target, Columns("P")) Is Nothing Then
    Target = UCase(Target)
    End If

    If Not Intersect(Target, Columns("R")) Is Nothing Then
    Target = UCase(Target)
    End If

    If Not Intersect(Target, Columns("X")) Is Nothing Then
    Target = UCase(Target)
    End If

    If Not Intersect(Target, Columns("AC")) Is Nothing Then
    Target = UCase(Target)
    End If

    If Not Intersect(Target, Columns("AG")) Is Nothing Then
    Target = UCase(Target)
    End If

    Application.EnableEvents = True  ' facultatif
' Minuscule
If Target.Count > 1 Or Target.Value = "" Then Exit Sub
    Application.EnableEvents = False
    If Not Intersect(Target, Columns("J")) Is Nothing Then
    Target = WorksheetFunction.Proper(Target.Value)
    End If

    If Not Intersect(Target, Columns("L")) Is Nothing Then
    Target = WorksheetFunction.Proper(Target.Value)
    End If

    If Not Intersect(Target, Columns("O")) Is Nothing Then
    Target = WorksheetFunction.Proper(Target.Value)
    End If

    If Not Intersect(Target, Columns("Q")) Is Nothing Then
    Target = WorksheetFunction.Proper(Target.Value)
    End If

    If Not Intersect(Target, Columns("Y")) Is Nothing Then
    Target = WorksheetFunction.Proper(Target.Value)
    End If

    If Not Intersect(Target, Columns("AA")) Is Nothing Then
    Target = WorksheetFunction.Proper(Target.Value)
    End If

    If Not Intersect(Target, Columns("AD")) Is Nothing Then
    Target = WorksheetFunction.Proper(Target.Value)
    End If

    If Not Intersect(Target, Columns("AF")) Is Nothing Then
    Target = WorksheetFunction.Proper(Target.Value)
    End If
    If Not Intersect(Target, Columns("AH")) Is Nothing Then
    Target = WorksheetFunction.Proper(Target.Value)
    End If
    Application.EnableEvents = True

End Sub

crdlt,

André

Le 15/03/2021 à 09:53

Bonjour

Pour andre 13, votre formule marche a merveille, mais en faisant des relevés, j'ai parfois des métiers en plusieurs mots :

Pouvez m'ajouter une fonction en macron qui me permette d'écrire maître de cabotage en Maître de cabotage avec seulement la 1ère lettre en majuscule. je ne l'utiliserais que pour les métiers. L'avantage de votre formule c'est que je peux changer les lettres en fonction du tableau que j'utilise.

Merci

Cordialement

Le 15/03/2021 à 17:57

Bonjour toutes et tous

merci du retour désolé du retard,, si ce n'est que pour mettre le mot Maître

un exemple au pifomètre -;)

Attention exemple non présent sur la feuille saisie juste pour un test ! :avec un bouton de commande cliquable si l'on veut, nommé Bouton1 sur la feuille SAISIE,la colonne BJ pour le métier principal et colonne BL étant pour un métier secondaire, s'y trouve maître mal orthographié et ne présentant pas la première lettre en majuscule, clic sur le bouton et mettrait correctement Maître (@tester)

si j'ai compris la demande, la fonction substitue peut-être ferait l'affaire

Sub Bouton1_Cliquer()
With Worksheets("SAISIE")
.Range("BJ:BJ", "BL:BL").Replace "maître", "Maître"
.Range("BJ:BJ", "BL:BL").Replace "maitre", "Maître"
End With
End Sub

crdlt,

André

Le 16/03/2021 à 11:07

Bonjour

je pense que je me suis mal expliqué. En effet, cela concerne d'une façon générale les métiers à plusieurs mots

Exemple : maître au cabotage, préposé des douanes, commissaire de police etc. Ce ne sont pas les seuls et je ne peux pas faire une liste exhaustive.

Est ce possible de compléter la 1ère macro ?

Cordialement

Rechercher des sujets similaires à "modifier format donnees entree minuscule"