XL 2013 [Résolu] Incrémenation ID suivant combobox et m à j de ses données en automatique

[dilack]

Bonjour à tous,

J'ai commencé mon premier code et je bute sur deux choses.

La première est la création d'un "ID" alphanumérique suivant les trois premiers caractères d'une valeur lors d'une entrée d'un UserForm
exemple:
si mon entrée en "Domaine" est "ASSAINISSEMENT" alors mon "ID" sera ASS001 et ainsi de suite.
Pour l'instant ce n'est que du numérique.

Ensuite
Si je rentre des valeurs dans les champs "Domaine" et "Type Document" qui n'existent pas dans les données de la feuilles "DATA", je souhaite qu'excel les rajoute automatiquement dans les colonnes correspondantes.

si je suis pas trop clair, signaler le moi et je ferais des efforts ... lol (en tout cas c'est clair dans ma tete c'est le pricipal ... rire)

Je vous laisse ma feuille ca sera sans doute plus facile a comprendre....

Je suis preneur de toutes remarques concernant mon premier code, bonnes ou mauvaise.

Par avance merci pour vos réponses.

 

[jp14]

Re : Aide VBA pour valeur alphanumérique et autre

Bonsoir

Ci dessous les procédures souhaitées

Private Sub Domaine_Change()
Dim Data1 As String, Cellule1 As Range, Nbt As Integer, Nb As Integer, B1 As Byte
With Sheets("LISTING")
If Len(Domaine.Value) > 4 Then
    Data1 = Left(Domaine.Value, 3)
    For Each Cellule1 In .Range("A2:A" & .Range("a" & .Rows.Count).End(xlUp).Row)
        If Left(Cellule1, 3) = Data1 Then
            Nb = Val(Right(Cellule1, 3))
            If Nb > Nbt Then Nbt = Nb
        End If
    Next Cellule1
    If Nbt < 10 Then
        B1 = 2
    ElseIf Nbt < 100 Then
        B1 = 1
    End If

    TextBox1 = Data1 & String(B1, "0") & (Nbt + 1)
End If
End With
End Sub


Private Sub Domaine_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim Dl1 As Long

If Domaine.ListIndex = -1 Then
If Len(Domaine.Value) < 3 Then
Call MsgBox("Le domaine doit comporter au minimum 3 lettres", vbInformation, Application.Name)
Domaine = ""
Cancel = True
Exit Sub
End If

With Sheets("DATA")
Dl1 = .Range("A" & .Rows.Count).End(xlUp).Row + 1
.Range("a" & Dl1) = Domaine.Value
End With
End If
End Sub

A tester

JP

 

[gilbert_RGI]

Re : Aide VBA pour valeur alphanumérique et autre

Bonjour,

modifier cette ligne

ActiveCell.Offset(0, -1).Value = ActiveCell.Offset(-1, -1).Value + 1

par celle ci



ActiveCell.Offset(0, -1).Value = Left(UserForm1.Domaine.Value, 3) & Format(ActiveCell.Offset(-1, -1).Value + 1, "000")

Private Sub Validation_Click()
i = 1
Do While Cells(i, 1) <> ""
Cells(i, 1).Offset(1, 1).Select
i = i + 1
Loop
ActiveCell.Value = UserForm1.Domaine.Value
ActiveCell.Offset(0, 1).Value = UserForm1.TitreDocument.Value
ActiveCell.Offset(0, 2).Value = UserForm1.TypeDocument.Value
ActiveCell.Offset(0, 3).Value = UserForm1.Editeur.Value
ActiveCell.Offset(0, 4).Value = UserForm1.Parution.Value
ActiveCell.Offset(0, 5).Value = UserForm1.DownLocal.Value
ActiveCell.Offset(0, 6).Value = UserForm1.DownCloud.Value
ActiveCell.Offset(0, 7).Value = UserForm1.Observations
If ActiveCell.Offset(-1, -1).Value = "ID" Then
ActiveCell.Offset(0, -1).Value = Left(UserForm1.Domaine.Value, 3) & Format("1", "000")
Else
ActiveCell.Offset(0, -1).Value = Left(UserForm1.Domaine.Value, 3) & Format(ActiveCell.Offset(-1, -1).Value + 1, "000")
End If
End Sub

 

[Modeste geedee]

Re : Aide VBA pour valeur alphanumérique et autre

Bonsour®
partie de code à remplacer dans validation_click

'If ActiveCell.Offset(-1, -1).Value = "ID" Then
'ActiveCell.Offset(0, -1).Value = 1
'Else
ActiveCell.Offset(0, -1).Value = Left(ActiveCell, 3) & Format(Application.CountIf(Range("b:b"), ActiveCell), "000")
'End If

attention toutefois à la création de doublon suite à suppression d'enregistrement

passer alors par une table en feuille DATA mémorisant le dernier n° ID créé par domaine...

 

[dilack]

Re : Aide VBA pour valeur alphanumérique et autre

Bonjour,

Merci à tous les trois pour vos réponses

@gilbert_RGI:
le code fonctionne pour la première ligne mais ensuite j'ai une erreur que j'arrive pas à cerner.
L'incrémentation se fait correctement, par contre si je rajoute un "Domaine" dans la combobox de l'UserForm celui ci se rajouter pas à la liste déjà existante de la feuille "DATA"

@jp14:
Le code fonctionne pour le rajout d'une valeur dans la combobox "Domaine" mais l'incrémentation ne se fait pas comme je le souhaiterais, il faudrait que celle ci se fasse suivant la combobox "Domaine" c'est à dire ASS001, ASS002, ... ASS150, pour "ASSAINISSEMENT" et TERR001, TERR002, ...TERR150 pour "TERRASSEMENT" et ainsi de suite pour chaque domaine. Avec le code l'incrémentation se fait de 1 en 1 quelque soit le "Domaine"
Quelle ligne je devrais supprimer pour avoir la même philosophie de rajout dans la liste pour la combobox "TypeDocument" sans avoir la restriction du nombre de caractère, et sans d’incrémentation?

@ Modeste geedee:
Je viens de voir ta réponse, je teste et je re.
Il n'y auras pas de suppression, je serais tranquille avec les doublons... (pour une fois ..rire)

Je vous mets les fichiers suivant vos réponses respectives.

Si vous avez besoin de plus de précision ...
C'est vrai que c'est claire dans ma tête ... mais l'explication...

Merci d'avance pour les futures réponses.

 

[Modeste geedee]

Re : Aide VBA pour valeur alphanumérique et autre

Bonsour®

Il n'y auras pas de suppression, je serais tranquille avec les doublons... (pour une fois ..rire).

voir pièce jointe
supprimer l'un des enregistrements ASSAINNISEMENT
puis valider un nouvel enregistrement ...

 

[dilack]

Re : Aide VBA pour valeur alphanumérique et autre

Re..

@ Modeste geedee:
Merci pour la modif sur le fichier cela conviens parfaitement pour l'incrémentation ... cool

 

[jp14]

Re : Aide VBA pour valeur alphanumérique et autre

Bonjour

Ci joint le fichier avec des modifications :
Ajout d'une colonne pour tenir compte du nombre de carractères pour la numérotation.
Ajout d'une valeur dans "Domaine" en majuscule

A tester

JP

 

[dilack]

Re : Aide VBA pour valeur alphanumérique et autre

Bonjour à tous,

@ jp14:
Il y a un petit soucis sur ton code. Si j’efface toute les données du tableau et que je recommence la saisie de données, je me retrouve avec, des cellules vide.

Je suis entrain de préparé un nouveau message et fichier dans le même fil de discutions avec des explications plus précises et plus explicites.
Mes explications de départ ne doivent pas être très compréhensives, et pourtant dans ma tête çà l'est ... lol

Merci pour le temps passé sur mon problème

 

[dilack]

Re : Incrémenation ID suivant combobox et mise à jour de ses données en automatique

Re bonjour,

Ce que je cherche:

- une incrémentation suivant la valeur de la colonne "Domaine" du style ASS001, ASS002, ASS003, ... ASSn Merci à "Modeste geedee"

Oups ... Par contre je viens de m’apercevoir que la valeur "Domaine" pouvait avoir deux noms (ex: SIGNALISATION LUMINEUSE) , ce qui faudrait c'est de prendre les deux premiers caractères du premier nom et le premier caractère du deuxième nom, et de prendre les trois premiers caractères si le "Domaine" à un seul non -----> ex: SIL001​

- Trier les données suivant leur ID.

- Si nouvelle valueur de "Domaine" qui n'existe pas dans la combobox du formulaire "Saisie de document", les intégrer dans les données de la combobox et les "Trier ,de A à Z"

- Si nouvelle valueur de "TypeDocument" qui n'existe pas dans la combobox du formulaire "Saisie de document", les intégrer dans les données de la combobox et les "Trier ,de A à Z"

- Je voudrais faire une boucle dans ma validation de saisie en effacant les données saisies, précédemnent afin d'enchainer la saisie.
Pour l'instant j'ai mis ce code mais je pense qu'il y a plus simple enfin plus "règle de l'art"

Unload Me
UserForm1.Show

Dans un deuxième temps:

- Remplacer les "Textes à afficher" des liens hypertexte des colonnes "Local" et "Cloud" par "Visualiser" et "Télécharger" afin de visualiser et/ou télécharger un document en direct

- Est-il possible de stocker que l'identifiant d'un compte "google" quand on souhaite "Télécharger" un document?



Je vous mets mon code en totalité et la feuille qui va bien

Private Sub Annuler_Click() 'Sortie du formulaire sans effacement des données déjà remplies
UserForm1.Hide
End Sub

Private Sub Quitter_Click() 'Sortie du formulaire avec effacement des données déjà remplies
Unload UserForm1
End Sub

Private Sub UserForm_Initialize() 'Ouverture du formulaire de Saisie de document
Dim i As Integer
i = 2
Do While Worksheets("DATA").Cells(i, 1) <> ""
'Récupération des données pour combobox Domaine
Domaine.AddItem Worksheets("DATA").Cells(i, 1)
'Récupération des données pour combobox TypeDocument
TypeDocument.AddItem Worksheets("DATA").Cells(i, 3)
i = i + 1
Loop
End Sub

Private Sub Validation_Click()
i = 1
Do While Cells(i, 1) <> ""
Cells(i, 1).Offset(1, 1).Select
i = i + 1
Loop
ActiveCell.Value = UserForm1.Domaine.Value
ActiveCell.Offset(0, 1).Value = UserForm1.TitreDocument.Value
ActiveCell.Offset(0, 2).Value = UserForm1.TypeDocument.Value
ActiveCell.Offset(0, 3).Value = UserForm1.Editeur.Value
ActiveCell.Offset(0, 4).Value = UserForm1.Parution.Value
ActiveCell.Offset(0, 5).Value = UserForm1.DownLocal.Value
ActiveCell.Offset(0, 6).Value = UserForm1.DownCloud.Value
ActiveCell.Offset(0, 7).Value = UserForm1.Observations
' Incrémentation forme XXX001 Merci à Modeste geedee
ActiveCell.Offset(0, -1).Value = Left(ActiveCell, 3) & Format(Application.CountIf(Range("b:b"), ActiveCell), "000")
Unload Me
UserForm1.Show
End Sub

Merci d'avance pour vos réponses et du temps passé.

 

[jp14]

Re : Incrémenation ID suivant combobox et mise à jour de ses données en automatique

Bonjour

Ci joint le fichier avec une correction pour les cas suivants 3 ou 4 carractères. Le préfixe se trouvant dans la colonne B de "Data"

c'est à dire ASS001, ASS002, ... ASS150, pour "ASSAINISSEMENT" et TERR001, TERR002, ...TERR150

Il suffit de suppprimer la couleur des cellules pour que le code suivant fonctionne.

Dl1 = .Range("A" & .Rows.Count).End(xlUp).Row + 1

J'ai rajouté une procédure pour effacer les données

For Each £Ctrl In Me.Controls
    Select Case TypeName(£Ctrl)
        Case "ComboBox", "TextBox"
              £Ctrl.Value = ""
    End Select
Next £Ctrl

Bonne journée

JP

 

[dilack]

Re : Incrémenation ID suivant combobox et mise à jour de ses données en automatique

Merci jp14, Modeste geedee, gilbert_RGI, pour vos réponses.

@jp ... je me suis orienté sur une autre solution, le résultat obtenu ne me convenait pas trop, merci encore du temps passé sur ma demande