Fomat personnalisé

C

Comanche77

XLDnaute Nouveau
Bonjour à tous
Lors d'une précédente discussion ,j'ai utilisé un format personnalisé conseillé : * @ ou @ *
Dans les cellule on saisie des valeurs D001 ou R002 ou T003 ou C004
j'aimerai si l’utilisateur saisie R25 avoir dans ma cellule R025 soit toujours 3 chiffres derrière la lettre MAIS en conservant le format personnalisé proposé ( * @ ou @ * ) afin d'avoir le bon cadrage

J'ai pas trop trouvé sur le forum

Merci d'avance Jean-rené
 
Trier par date Trier par votes
Modeste geedee

Modeste geedee

XLDnaute Barbatruc
Re : Fomat personnalisé

Bonsour®
il faut utiliser une procédure événementielle... :rolleyes:

comme tu ne proposes pas d'exemple concret de typologie ...:(
voici une proc s'appliquant à la plage : C5:C20
VB: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Range("C5:C20"), Target) Is Nothing Then
   Target = UCase(Left(Target, 1)) & Format(Mid(Target, 2, 3), "000")
'----éventuellemnt -ici le format personnalisé proposé
'  Target.NumberFormat = "*-@"
   End If
End Sub

nb : que faire si la saisie n'est pas Alpha+3num
 
Vote positif 0 Vote négatif
C

Comanche77

XLDnaute Nouveau
Hello
Il est vrai que je n'ai pas mis d'exemple . Sur ces cellules j'ai mis en place une validation de données proposée dans une discussion précédente par validation de données :
=OU(GAUCHE($F8)="T";GAUCHE($F8)="D";GAUCHE($F8)="C";GAUCHE($F8)="R")
et un message d'erreur si je n'ai pas T ou D ou C ou R
Votre pièce comptable doit commencer par D, T, R ou C :par exemple D006
je cadre les pièces D à droite , les piéces R a gauche et les pièces T et C au centre par mise en forme conditionnelle et format personnalisé en utilisant : @ * ou * @ (toujours proposé par le forum)

Comme tu vois ce que je désire c'est avoir une des 4 lettres suivi d'un nombre à 3 chiffres car souvent on me rend le fichier en commençant par D1 et il me faut attendre la pièce N° 100 pour avoir les 3 chiffres.
J'aimerai donc si on saisie D1 avoir D001 (idem pour R , T ou C)

je te joins mon fichier de test

Hello , J'ai déjà une macro dans mon exemple et je ne suis pas un spécialiste
Si tu modifies , intègre directement et explique moi

merci d' avance
Jean-rené


merci
 

Pièces jointes

  • Compta 2015 2016_XA.xlsm
    128.8 KB · Affichages: 48
  • Compta 2015 2016_XA.xlsm
    128.8 KB · Affichages: 47
Dernière édition:
Vote positif 0 Vote négatif
T

Tentative

XLDnaute Occasionnel
Re : Fomat personnalisé

Bonjour,

Voici une tentative à tester avant d'intégrer : (modifié)
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim L As Byte
Dim P As String

If Not Intersect(Range("F8:F888"), Target) Is Nothing Then

On Error Resume Next
L = Len(Target.Value)

If L = 4 Then P = Right(Target, 3)
If L = 3 Then P = Right(Target, 2)
If L = 2 Then P = Right(Target, 1)

Select Case L
Case 1
   If Left(Target, 1) = "C" Then MsgBox " Saisir un numéro en plus de la Lettre"
   If Left(Target, 1) = "D" Then MsgBox " Saisir un numéro en plus de la Lettre"
   If Left(Target, 1) = "R" Then MsgBox " Saisir un numéro en plus de la Lettre"
   If Left(Target, 1) = "T" Then MsgBox " Saisir un numéro en plus de la Lettre"
      
   If Left(Target, 1) = "c" Then MsgBox " Saisir un numéro en plus de la Lettre"
   If Left(Target, 1) = "d" Then MsgBox " Saisir un numéro en plus de la Lettre"
   If Left(Target, 1) = "r" Then MsgBox " Saisir un numéro en plus de la Lettre"
   If Left(Target, 1) = "t" Then MsgBox " Saisir un numéro en plus de la Lettre"

Case 2
   If Left(Target, 1) = "C" Then Target = Target & "00" & P
   If Left(Target, 1) = "D" Then Target = Target & "00" & P
   If Left(Target, 1) = "R" Then Target = Target & "00" & P
   If Left(Target, 1) = "T" Then Target = Target & "00" & P
   If Left(Target, 1) = "c" Then Target = UCase(Left(Target, 1)) & "00" & P
   If Left(Target, 1) = "d" Then Target = UCase(Left(Target, 1)) & "00" & P
   If Left(Target, 1) = "r" Then Target = UCase(Left(Target, 1)) & "00" & P
   If Left(Target, 1) = "t" Then Target = UCase(Left(Target, 1)) & "00" & P

Case 3
   If Left(Target, 1) = "C" Then Target = Target & "0" & P
   If Left(Target, 1) = "D" Then Target = Target & "0" & P
   If Left(Target, 1) = "R" Then Target = Target & "0" & P
   If Left(Target, 1) = "T" Then Target = Target & "0" & P
   If Left(Target, 1) = "c" Then Target = UCase(Left(Target, 1)) & "0" & P
   If Left(Target, 1) = "d" Then Target = UCase(Left(Target, 1)) & "0" & P
   If Left(Target, 1) = "r" Then Target = UCase(Left(Target, 1)) & "0" & P
   If Left(Target, 1) = "t" Then Target = UCase(Left(Target, 1)) & "0" & P

Case 4
   If Left(Target, 1) = "c" Then Target = UCase(Left(Target, 1)) & P
   If Left(Target, 1) = "d" Then Target = UCase(Left(Target, 1)) & P
   If Left(Target, 1) = "r" Then Target = UCase(Left(Target, 1)) & P
   If Left(Target, 1) = "t" Then Target = UCase(Left(Target, 1)) & P
   
End Select
End If
End Sub

Il y a sûrement amélioration possible avec de meilleures connaissances.

Note : il manque la gestion en saisie de plus d'une lettre et de plus de 4 caractères

Tentative
 
Dernière édition:
Vote positif 0 Vote négatif
C

Comanche77

XLDnaute Nouveau
Re : Fomat personnalisé

RE,

Voilà mes premiers tests

cela fonctionne sans blocage MAIS si je saisie D9 j'obtiens D9009
idem pour R10 donne R10010 ainsi que pour les C et T

merci pour ton aide

Jean-rené

je te joins mon fichier de test , tu y verras le résultat
 

Pièces jointes

  • Compta 2015 2016_XA.xlsm
    129.4 KB · Affichages: 42
  • Compta 2015 2016_XA.xlsm
    129.4 KB · Affichages: 38
Vote positif 0 Vote négatif
T

Tentative

XLDnaute Occasionnel
Re : Fomat personnalisé

Bonjour,

Sur Excel 2013, le code fonctionne correctement avec ton fichier du post #8 (note: il serait bien d'enlever les mdp avant de poster, ça serait plus convivial pour nous, merci).
Cela provient probablement d'un dysfonctionnement sur Excel 2007.
Dans mon environnement, Excel 2007 commence à se faire rare.
Je vais tenter de trouver une machine sur laquelle l'installer afin de tester dans le même environnement que chez toi.

Je regarde cela après le boulot.


Tentative
 
Vote positif 0 Vote négatif
C

Comanche77

XLDnaute Nouveau
Re : Fomat personnalisé

hello
j'ai modifié comme ceci et cela fonctionne pour l'instant

Dim L As Byte
Dim P As String

If Not Intersect(Range("F8:F999"), Target) Is Nothing Then

On Error Resume Next
L = Len(Target.Value)
j = Left(Target, 1)

If L = 4 Then P = Right(Target, 3)
If L = 3 Then P = Right(Target, 2)
If L = 2 Then P = Right(Target, 1)

Select Case L
Case 1
If Left(Target, 1) = "C" Then MsgBox " Saisir un numéro en plus de la Lettre"
If Left(Target, 1) = "D" Then MsgBox " Saisir un numéro en plus de la Lettre"
If Left(Target, 1) = "R" Then MsgBox " Saisir un numéro en plus de la Lettre"
If Left(Target, 1) = "T" Then MsgBox " Saisir un numéro en plus de la Lettre"



Case 2
If Left(Target, 1) = "C" Then Target = j & "00" & P
If Left(Target, 1) = "D" Then Target = j & "00" & P
If Left(Target, 1) = "R" Then Target = j & "00" & P
If Left(Target, 1) = "T" Then Target = j & "00" & P
If Left(Target, 1) = "c" Then Target = j & "00" & P
If Left(Target, 1) = "d" Then Target = j & "00" & P
If Left(Target, 1) = "r" Then Target = j & "00" & P
If Left(Target, 1) = "t" Then Target = j & "00" & P


Case 3
If Left(Target, 1) = "C" Then Target = j & "0" & P
If Left(Target, 1) = "D" Then Target = j & "0" & P
If Left(Target, 1) = "R" Then Target = j & "0" & P
If Left(Target, 1) = "T" Then Target = j & "0" & P
If Left(Target, 1) = "c" Then Target = j & "0" & P
If Left(Target, 1) = "d" Then Target = j & "0" & P
If Left(Target, 1) = "r" Then Target = j & "0" & P
If Left(Target, 1) = "t" Then Target = j & "0" & P


Case 4
If Left(Target, 1) = "C" Then Target = UCase(Left(Target, 1)) & P
If Left(Target, 1) = "D" Then Target = UCase(Left(Target, 1)) & P
If Left(Target, 1) = "R" Then Target = UCase(Left(Target, 1)) & P
If Left(Target, 1) = "T" Then Target = UCase(Left(Target, 1)) & P
If Left(Target, 1) = "c" Then Target = UCase(Left(Target, 1)) & P
If Left(Target, 1) = "d" Then Target = UCase(Left(Target, 1)) & P
If Left(Target, 1) = "r" Then Target = UCase(Left(Target, 1)) & P
If Left(Target, 1) = "t" Then Target = UCase(Left(Target, 1)) & P

End Select
End If
End Sub

merci
 
Vote positif 0 Vote négatif
T

Tentative

XLDnaute Occasionnel
Re : Fomat personnalisé

Bonjour,

Je viens de comprendre ton problème : chez moi je ne testais que saisissant des minuscules et, là, ça fonctionne.
Si on saisit des majuscules, là, ça ne passe plus.
Désolé de n'avoir pas fait autant de tests que nécessaire.
Je regarde cela dès mon retour en fin p.m. (UTC -5:00)


Tentative
 
Vote positif 0 Vote négatif
C

Comanche77

XLDnaute Nouveau
Hello
j'ai modifié comme ceci , j'ai bien la transformation requise mais j'ai ensuite un Msg
Erreur d’exécution 28
Espace pile insuffisant
et dans le déboggage il se positionne sur
Set Plage = Range("F8:F999") 'colonne numéro pièce comptable

comme je ne connais pas les macros , je cale

merci à toi



1:
Dim L As Byte
Dim P As String
Dim J As String

If Not Intersect(Range("F8:F999"), target) Is Nothing Then

On Error Resume Next
L = Len(target.Value)
J = Left(target, 1)

If L = 4 Then P = Right(target, 3)
If L = 3 Then P = Right(target, 2)
If L = 2 Then P = Right(target, 1)

Select Case L
Case 1
If Left(target, 1) = "C" Then MsgBox " Saisir un nombre de 3 chiffres en plus de la Lettre"
If Left(target, 1) = "D" Then MsgBox " Saisir un nombre de 3 chiffres en plus de la Lettre"
If Left(target, 1) = "R" Then MsgBox " Saisir un nombre de 3 chiffres en plus de la Lettre"
If Left(target, 1) = "T" Then MsgBox " Saisir un nombre de 3 chiffres en plus de la Lettre"
If Left(target, 1) = "c" Then MsgBox " Saisir un nombre de 3 chiffres en plus de la Lettre"
If Left(target, 1) = "d" Then MsgBox " Saisir un nombre de 3 chiffres en plus de la Lettre"
If Left(target, 1) = "r" Then MsgBox " Saisir un nombre de 3 chiffres en plus de la Lettre"
If Left(target, 1) = "t" Then MsgBox " Saisir un nombre de 3 chiffres en plus de la Lettre"




Case 2
If Left(target, 1) = "C" Then target = J & "00" & P
If Left(target, 1) = "D" Then target = J & "00" & P
If Left(target, 1) = "R" Then target = J & "00" & P
If Left(target, 1) = "T" Then target = J & "00" & P
If Left(target, 1) = "c" Then target = J & "00" & P
If Left(target, 1) = "d" Then target = J & "00" & P
If Left(target, 1) = "r" Then target = J & "00" & P
If Left(target, 1) = "t" Then target = J & "00" & P


Case 3
If Left(target, 1) = "C" Then target = J & "0" & P
If Left(target, 1) = "D" Then target = J & "0" & P
If Left(target, 1) = "R" Then target = J & "0" & P
If Left(target, 1) = "T" Then target = J & "0" & P
If Left(target, 1) = "c" Then target = J & "0" & P
If Left(target, 1) = "d" Then target = J & "0" & P
If Left(target, 1) = "r" Then target = J & "0" & P
If Left(target, 1) = "t" Then target = J & "0" & P


Case 4
If Left(target, 1) = "C" Then target = UCase(Left(target, 1)) & P
If Left(target, 1) = "D" Then target = UCase(Left(target, 1)) & P
If Left(target, 1) = "R" Then target = UCase(Left(target, 1)) & P
If Left(target, 1) = "T" Then target = UCase(Left(target, 1)) & P
If Left(target, 1) = "c" Then target = UCase(Left(target, 1)) & P
If Left(target, 1) = "d" Then target = UCase(Left(target, 1)) & P
If Left(target, 1) = "r" Then target = UCase(Left(target, 1)) & P
If Left(target, 1) = "t" Then target = UCase(Left(target, 1)) & P

End Select
End If
End Sub
'
 

Pièces jointes

  • Compta 2015 2016_XA.xlsm
    107 KB · Affichages: 39
  • Compta 2015 2016_XA.xlsm
    107 KB · Affichages: 34
Dernière édition:
Vote positif 0 Vote négatif
tototiti2008

tototiti2008

XLDnaute Barbatruc
Re : Fomat personnalisé

Bonjour Commanche, Bonjour Tentative,

Peut-être un truc comme ça ?

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim P As String



    If Not Intersect(Range("F8:F888"), Target) Is Nothing Then
    
        If Len(Target.Value) = 1 And InStr("CDRT", UCase(Target.Value)) > 0 Then
            MsgBox "Saisir un numéro en plus de la Lettre"
        ElseIf InStr("CDRT", UCase(Left(Target.Value, 1))) > 0 Then
            P = Right(Target.Value, Len(Target.Value) - 1)
            If Not IsNumeric(P) Then
                MsgBox "Saisir un numéro en plus de la Lettre"
            Else
                Application.EnableEvents = False
                Target = UCase(Left(Target, 1)) & Format(CLng(P), "000")
                Application.EnableEvents = True
            End If
        End If
    End If
End Sub
 
Vote positif 0 Vote négatif
T

Tentative

XLDnaute Occasionnel
Re : Fomat personnalisé

tototiti2008 à dit:
Bonjour Commanche, Bonjour Tentative,

Peut-être un truc comme ça ?

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim P As String

    If Not Intersect(Range("F8:F888"), Target) Is Nothing Then
    
        If Len(Target.Value) = 1 And InStr("CDRT", UCase(Target.Value)) > 0 Then
            MsgBox "Saisir un numéro en plus de la Lettre"
        ElseIf InStr("CDRT", UCase(Left(Target.Value, 1))) > 0 Then
            P = Right(Target.Value, Len(Target.Value) - 1)
            If Not IsNumeric(P) Then
                MsgBox "Saisir un numéro en plus de la Lettre"
            Else
                Application.EnableEvents = False
                Target = UCase(Left(Target, 1)) & Format(CLng(P), "000")
                Application.EnableEvents = True
            End If
        End If
    End If
End Sub
Cliquez pour agrandir...

Bonjour,

Je trouve cela vraiment beau du code comme celui-là.
Je le lis et je le comprends.
Mais, je ne vois pas dans mon avenir réussir à me rendre à ce niveau là.
Je lis avec passion.


Tentative
 
Vote positif 0 Vote négatif

Discussions similaires

laurent950
  • Question
XL 2013 Les Fonctions personnalisé avec Aide à la saisie et Aide boite de dialogue
Réponses
0
Affichages
2 K
laurent950
laurent950
C
  • Question
Cadrage gauche ou droite
2
Réponses
15
Affichages
3 K
chris
chris
M
  • Question
Formule NB à 2 conditions
Réponses
2
Affichages
686
marion125cbr
M
Brigitte
  • Question
Format personnalisé : résultat + texte
Réponses
4
Affichages
2 K
Brigitte
Brigitte
M
[REF] Wiki 5 de MichelXld (Formules, Audits de formules, Répertoires, Fichiers)
Réponses
0
Affichages
46 K
MichelXld
M
M
[REF] Wiki Page 8 de MichelXld
Réponses
0
Affichages
38 K
MichelXld
M
M
[REF] Wiki 4 de MichelXld (Fonctions, Evenements, Dates et calendriers, Flash , Ooo)
Réponses
0
Affichages
35 K
MichelXld
M
M
[REF] Wiki Page 9 de MichelXld
Réponses
0
Affichages
38 K
MichelXld
M
M
[REF] Wiki 6 de MichelXld (Doublons, Tris, Filtres, Variables, Fichiers fermés, Acces
Réponses
0
Affichages
68 K
MichelXld
M
M
[REF] Wiki Page 7 de MichelXld
Réponses
0
Affichages
51 K
MichelXld
M

Membres actuellement en ligne

2 membres et 67 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 571
Messages
2 089 805
Membres
104 276
dernier inscrit
helenevellocet