begin process at 2012 02 13 01:08:00
  Trouver un code source :
 
dans
 
Accueil > 

Code

 > 

VBA

 > INITIALE EN MAJUSCULE POUR PLUSIEURS NOMS INSCRITS A LA SUITE, EGALEMENT PRENOMS AVEC TIRET

INITIALE EN MAJUSCULE POUR PLUSIEURS NOMS INSCRITS A LA SUITE, EGALEMENT PRENOMS AVEC TIRET


 Information sur la source

Note :
5 / 10 - par 2 personnes
5,00 / 10

  • 1

  • 2

  • 3

  • 4

  • 5

  • 6

  • 7

  • 8

  • 9

  • 10
Catégorie :VBA Niveau :Débutant Date de création :05/03/2003 Date de mise à jour :17/05/2003 19:03:57 Vu :4 144

Auteur : mariochk

Ecrire un message privé
Site perso
Commentaire sur cette source (10)
Ajouter un commentaire et/ou une note

 Description

Pour Access, ce petit code VBA permet lors d'une saisie de plusieurs prénoms dans un champ (par ex : michel alain robert) de mettre une initiale à chacun des prénoms, soit : Michel Alain Robert dans ce cas. Une nouvelle mise à jour pour les prénoms avec tiret, ça manquait.

Source

  • Function convertInitMaj(envoi)
  • '[envoi] représente la variable qui doit être convertie
  • '[convertInitMaj] est [envoi] qui a été converti
  • Dim précèdeMaj() As String
  • TailleDim = 1 'définit le nombre de variables, soit 2 dans ce cas, vu qu'il faut
  • 'une majuscule après un espace et après un tiret
  • ReDim précèdeMaj(TailleDim)
  • précèdeMaj(0) = " " 'définit l'espace
  • précèdeMaj(1) = "-" 'définit le tiret
  • For compte = 0 To TailleDim
  • If IsNull(envoi) = False Then
  • convertInitMaj = UCase(Mid(envoi, 1, 1)) + Right(LCase(envoi), Len(envoi) - 1)
  • If InStr(envoi, précèdeMaj(compte)) Then
  • Do
  • a1 = InStr(Right(envoi, Len(envoi) - a2), précèdeMaj(compte))
  • tmp = Left(tmp, a2) + UCase(Mid(envoi, a2 + 1, 1)) + Right(envoi, Len(envoi) - a2 - 1)
  • a2 = a2 + a1
  • convertInitMaj = tmp
  • Loop Until a1 = 0
  • End If
  • '....................................................................
  • End If
  • Next
  • End Function
Function convertInitMaj(envoi)

        '[envoi] représente la variable qui doit être convertie
        '[convertInitMaj] est [envoi] qui a été converti

Dim précèdeMaj() As String
TailleDim = 1                   'définit le nombre de variables, soit 2 dans ce cas, vu qu'il faut
                                'une majuscule après un espace et après un tiret
                                
ReDim précèdeMaj(TailleDim)
précèdeMaj(0) = " "             'définit l'espace
précèdeMaj(1) = "-"             'définit le tiret

For compte = 0 To TailleDim
If IsNull(envoi) = False Then
    convertInitMaj = UCase(Mid(envoi, 1, 1)) + Right(LCase(envoi), Len(envoi) - 1)
    If InStr(envoi, précèdeMaj(compte)) Then
        Do
            a1 = InStr(Right(envoi, Len(envoi) - a2), précèdeMaj(compte))
            tmp = Left(tmp, a2) + UCase(Mid(envoi, a2 + 1, 1)) + Right(envoi, Len(envoi) - a2 - 1)
            a2 = a2 + a1
            convertInitMaj = tmp
        Loop Until a1 = 0
    End If
    '....................................................................
End If
Next

End Function

    

 Conclusion

La liste des précèdeMaj() n'est pas exhaustive, on peut tout aussi bien s'imaginer d'une liste de prénoms séparés par des virgules ou des "_" comme le précise akastels. Par contre, je n'ai pas testé avec des retours chariots, n'en ayant pas l'utilité.

PS pour VicoLaChips2, l'utilitaire : "vbProperCase" ne met malheureusement pas de MAJ après les tirets ...



 Sources du même auteur

POUR QU'ACCESS RECONNAISSE LE CHAMP COMME ADRESSE E-MAIL UTI...

 Sources de la même categorie

Source avec Zip GESTION PERSONNEL par oudlarbi
Source avec Zip Source avec une capture CALENDRIER EN VBA POUR EXCEL 2010 par nounou94
Source avec Zip Source avec une capture MANIPULER LES FENETRES ENFANT D'EXCEL par bigfish_le vrai
Source avec Zip Source avec une capture COLLECTION ID par Le Pivert
Source avec Zip Source avec une capture VBA MASQUE DE SAISIE NUMÉRIQUE par acive

Commentaires et avis

Commentaire de tmcuh le 05/03/2003 18:52:51

Super à vrai dire il va me servir pour un prog mais je n'avais jamais pensé à le faire.
9/10 car il manque end if à la fin. ;-)

Commentaire de KaViDee le 05/03/2003 20:23:12

T'as pas l'impression de t'être inspiré de ma source.
http://www.vbfrance.com/article.aspx?Val=7956
Comme par hazard, juste qd je poste ma source, tu me chies ça dessuite après.
Même si c'est un peu modifié, ya des parties de codes de ma sources.
T'es vraiment pas fin, t'as juste changé la boucle For par une Do:

txtTitre = UCase(Left(txtTitre, 1)) & Right(txtTitre, Len(txtTitre) - 1)
For i = 1 To Len(txtTitre)
If Mid(txtTitre, i, 1) = " " Then
txtTitre = Left(txtTitre, i) & UCase(Mid(txtTitre, i + 1, 1)) & Right(txtTitre, Len(txtTitre) - i - 1)
End If
Next i

(C'est un morceau de ma source)

Copieur

Commentaire de KaViDee le 05/03/2003 20:27:42

Pour la peine je te mets 1

Commentaire de mariochk le 05/03/2003 22:53:16

N'importe quoi, j'ai cherché dans le code source avec majuscule ou initiale et rien n'est sorti, alors j'ai créé qqch, sans savoir qu'un autre flan faisait de même, POUR QUI TU ME PRENDS TAS DE NEIGE ? CHUI PAS TOMBE DE LA POUSSETTE !

Commentaire de mariochk le 05/03/2003 23:28:15

En + t'as fait un mid pour chercher l'espace alors que j'ai fait un right, si je t'avais copié, j'aurais changé une virgule pas une commande (...)Quant à la ligne
txtTitre = Left(txtTitre, i) & ... etc
n'importe quel tdc de programmeur aurait fait de même pour concaténer les 3 éléments !!!!! salut DIEU LE SAUVEUR

Commentaire de mariochk le 05/03/2003 23:39:27

EN +, TES 12 SUPER FONCTIONS SUPER UTILES NE SONT PAS FICHUES DE METTRE L'INITIALE EN MAJUSCULE A CHAQUE NOM INSERES SUR UNE LIGNE BEURK ! ENCORE UNE PREUVE QUE JE T'AI PAS COPIE ET J'AI BIEN FAIT, SINON JE DEVRAIS ENCORE ME CREUSER POUR TROUVER LA SOLUCE ! Salut petit dieu

Commentaire de KaViDee le 06/03/2003 00:15:10

Mes 12 Fonctions super utiles, c'est un vieux truc tout pourri que j'avais fais il y longtemps et qd je venais tout juste de découvrir ces fonctions.
Et l'algo qui permet de mettre tous les mots en majuscule je viens de le trouver aujourd'hui.
Salut grand Dieu...

Commentaire de VicoLaChips2 le 06/03/2003 18:22:21

Autrement il y a une fonction incluse à vba :
dim result as string
result = strConv(MaChaineDeCaractere,vbProperCase)
@+

Commentaire de mariochk le 06/03/2003 22:18:51

Autant pour moi, je l'ai pourtant cherchée cette commande, mais depuis l'aide ACCESS avec des mots clés (INITIALE, MAJUSCULE, etc ) NADA ! MERCI A TOI ça me réconcilie avec VB car je trouvais un peu débile de devoir créer à la main une commande qui aurait dû être inclue ...

Commentaire de akastels le 17/05/2003 17:23:33

Voici le code que j'emploie depuis longtemps (je dis ça au cas où...):
Function PremMaj()
        Dim SD As Variant, mc As Control, I As Integer
        Dim mf As Form
        Set mf = Screen.ActiveForm
        mf.HelpContextId = 1
        Set mc = Screen.ActiveControl
        mc = UCase(Left(Trim(mc), 1)) & Mid(Trim(mc), 2)
            For I = 1 To Len(mc) - 1
            SD = Mid(mc, I, 1)
                If SD = "-" Or SD = "_" Or SD = " " Or Asc(SD) = 13 Or Asc(SD) = 10 Then
                    mc = Left(mc, I) & UCase(Mid(mc, I + 1, 1)) & Mid(mc, I + 2)
                Else
                    mc = Left(mc, I) & LCase(Mid(mc, I + 1))
                End If
            Next I
            mc = Trim(mc)
End Function

Celui-ci a l'avantage de mettre la majuscule au 2ème prénom si celui-ci est composé, puis après un retour chariot, à la ligne, ou séparé par "_".

 Ajouter un commentaire




Nos sponsors


Sondage...

Comparez les prix

CalendriCode

Février 2012
LMMJVSD
  12345
6789101112
13141516171819
20212223242526
272829    

Consulter la suite du CalendriCode

Photothèque

 
Développement réalisé par Nicolas SOREL (Nix) avec l'aide de : Cyril DURAND et Emmanuel (EBArtSoft), Merci à Vincent pour ses précieux conseils.
CodeS-SourceS.com© Toute reproduction même partielle est interdite sauf accord écrit du Webmaster
CodeS-SourceS.com© est une marque déposée tous droits réservés

Google Coop CodeS-SourceS Google Coop CodeS-SourceS
Temps d'éxécution de la page : 0,484 sec (3)

Nous contacter | Annoncer sur CodeS-SourceS | Mentions légales