Modifier le format des données entrée en minuscule
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 =
Pouvez-vous m'aider ?
Cordialement
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
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
[Édition]
Bonjour Jean-Éric, nos posts se sont croisés...
- Messages
- 2'415
- Excel
- 2019
- Inscrit
- 13/07/2017
- Emploi
- Formateur, animateur,tech.informatique
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é
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
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.
Re,
Et moi, et moi !?
Cdlt.
- Messages
- 2'415
- Excel
- 2019
- Inscrit
- 13/07/2017
- Emploi
- Formateur, animateur,tech.informatique
Re,
@Jag8308, ===>les meilleurs codées sont celles de Thauthème
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é
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
- Messages
- 2'415
- Excel
- 2019
- Inscrit
- 13/07/2017
- Emploi
- Formateur, animateur,tech.informatique
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é
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