Identifiant unique

Le 28/09/2023 à 12:08

J'ai supprime la dernière ligne vide.

Mais pas d'incrementation ...

a+

Le 28/09/2023 à 12:38

j'ai trouve, j'ai repris votre premier code qui marchait, j'ai juste changer la variable de s en h comme suit:

Private Sub CommandButton5_Click()
Dim h
     With Sheets("DATABASE_VUSHF").Range("Tableau1").ListObject
          If .ListRows.Count > 0 Then
               With .DataBodyRange.Cells(.ListRows.Count, 1)
                    h = Left(.Value, 2) & Format(Mid(.Value, 3, 5) + 1, "00000") & "-1"
               End With
               With .ListRows.Add.Range
                    .Range("A1").Value = h   'nouvelle numéro en A1
                    .Range("AA1").Resize(, 5).Value = Array(TextBox26.Value, TextBox27.Value, TextBox28.Value, TextBox29.Value, TextBox30.Value)     'ces 5 textboxes en AA:AE
               End With
          Else
               MsgBox "problème, c'est la premiere ligne"
          End If
     End With

     Unload Me
     MODEMIDENTIFICATION.show
     UserForm_Initialize
End Sub

a+

Le 28/09/2023 à 12:50

J'ai tout vérifié au niveau fonctionnement c'est OK !

Un grand merci BsAlv !!!!

a+


Le 04/10/2023 à 14:55

Boujour BsAlv,

sur les 2 CommandButtons 5 et 14, j'ai juste une petite modification a faire sur vos codes afin d'avoir:

CommandButton5: format du type AA00001-01, AA00002-01, AA00003-01..... AA00010-01 ... (Pas en AA00001-1, AA00002-1, AA00003-1 ..... AA00010-1...)

CommandButton14: format du type AA00001-01, AA00001-02, AA00001-03

En vous remerciant,

@+

Le 04/10/2023 à 16:47

re,

la partie avec listrows.add est disparu, donc je ne connais pas la dernière version de votre fichier. Pourquoi la dernière ligne, est-elle vide ?

Pouvez-vous me joindre votre dernière version ?

Le 05/10/2023 à 05:41

Bonjour,

En fait, vos codes fonctionnent a merveille.

Quelques changement a adopter, juste pour un confort visuel.

1/ Pouvoir ranger mes identifiants dans l'ordre.

image

2/ Puis quand je clique sur le bouton 5, la listBox doit se mettre automatiquement a la dernière ligne créée, en colorant temporairement cette ligne pour bien la visualiser. (en bleue, comme si je sélectionne une ligne)

3/ Quand je clique sur le bouton 14, la listBox doit se mettre automatiquement a la ligne créée avec la ligne colorée temporairement en bleue (comme si je sélectionne une ligne)

@+

7draft-avec-listbox1.xlsm (112.19 Ko)
Le 05/10/2023 à 07:23

Re,

Private Sub CommandButton5_Click()
ListBox20.Selected(ListBox20.ListCount - 1) = True
     With Sheets("DATABASE_VUSHF").Range("Tableau1").ListObject
          If .ListRows.Count > 0 Then
               With .DataBodyRange.Cells(.ListRows.Count, 1)
                    h = Left(.Value, 2) & Format(Mid(.Value, 3, 5) + 1, "00000") & "-1"
               End With
               With .ListRows.Add.Range
                    .Range("A1").Value = h   'nouveau numéro en A1
                    .Range("AA1").Resize(, 5).Value = Array(TextBox26.Value, TextBox27.Value, TextBox28.Value, TextBox29.Value, TextBox30.Value)     'ces 5 textboxes en AA:AE
               End With
          Else
               MsgBox "problème, c'est la premiere ligne"
          End If
     End With

     Unload Me
     MODEMIDENTIFICATION.show
     UserForm_Initialize
End Sub

J'ai essaye de placer ce code dans le bouton 5

ListBox20.Selected(ListBox20.ListCount - 1) = True

Ou celui la

Rows(Range("A" & Rows.Count).End(xlUp).Row).Select

Ou celui la

Sheets("DATABASE_VUSHF").Activate

Range("A65536").End(xlUp).Offset(1, 0).Select

J'arrive pas a placer le code dans la commande bouton 5, quand j'elve "USF réinitialise" je vais a la dernière ligne mais quand j'incremente une ligne la listbox n'etant plus rafraichit, je ne vois pas les nouvelles insertions.

J'ai donc fait avec ce code, il va bien a la dernière ligne et puis la ListBox se repositionne tout en haut de la list, alors que je souhaiterais que ma Listbox se fixe sur cette dernière ligne incrémentée.

Private Sub CommandButton5_Click()

ListBox20.Selected(ListBox20.ListCount - 1) = True

     With Sheets("DATABASE_VUSHF").Range("Tableau1").ListObject
          If .ListRows.Count > 0 Then
               With .DataBodyRange.Cells(.ListRows.Count, 1)
                    h = Left(.Value, 2) & Format(Mid(.Value, 3, 5) + 1, "00000") & "-1"
               End With
               With .ListRows.Add.Range
                    .Range("A1").Value = h   'nouvelle numéro en A1
                    .Range("AA1").Resize(, 5).Value = Array(TextBox26.Value, TextBox27.Value, TextBox28.Value, TextBox29.Value, TextBox30.Value)     'ces 5 textboxes en AA:AE

               End With
          Else
               MsgBox "problème, c'est la premiere ligne"
          End If
     End With

     UserForm_Initialize
End Sub

a+

Le 05/10/2023 à 09:56

Re,

pour le bouton 5 j'ai trouve le code en jaune qui maintient la ListBox sur la ligne créée quand je réincrémente mon USF ne se réinitialise avec les nouvelles lignes:

Private Sub CommandButton5_Click()

     With Sheets("DATABASE_VUSHF").Range("Tableau1").ListObject
          If .ListRows.Count > 0 Then
               With .DataBodyRange.Cells(.ListRows.Count, 1)
                    h = Left(.Value, 2) & Format(Mid(.Value, 3, 5) + 1, "00000") & "-1"
               End With
               With .ListRows.Add.Range
                    .Range("A1").Value = h   'nouveau numéro en A1
                    .Range("AA1").Resize(, 5).Value = Array(TextBox26.Value, TextBox27.Value, TextBox28.Value, TextBox29.Value, TextBox30.Value)     'ces 5 textboxes en AA:AE
               End With

          Else
               MsgBox "problème, It's the first lign"
          End If
     End With
     MsgBox "new signature created!"
     UserForm_Initialize
     ListBox20.TopIndex = ListBox20.ListCount - 1

End Sub

ListBox20.TopIndex = ListBox20.ListCount - 1

A+

Le 05/10/2023 à 10:52

re,

pour le triage, vos macros SortData_1 & SortData_2, elles le font déjà (elles font la même chose, je crois)

Le 05/10/2023 à 11:37

J'ai réussi pour les boutons 5, 14 et 8.

bouton 5: la listbox se met automatiquement au niveau de ligne incrementee.

bouton 14: la listbox se met automatiquement au niveau de ligne incrementee en nouveau mode, 1 ere ligne visible en haut de la Listbox.

bouton 8: la listbox se met automatiquement au niveau de ligne modifiee, 1 ere ligne visible en haut de la Listbox.

Private Sub CommandButton5_Click()

With Sheets("DATABASE_VUSHF").Range("Tableau1").ListObject
If .ListRows.Count > 0 Then
With .DataBodyRange.Cells(.ListRows.Count, 1)
h = Left(.Value, 2) & Format(Mid(.Value, 3, 5) + 1, "00000") & "-1"
End With
With .ListRows.Add.Range
.Range("A1").Value = h 'nouveau numéro en A1
.Range("AA1").Resize(, 5).Value = Array(TextBox26.Value, TextBox27.Value, TextBox28.Value, TextBox29.Value, TextBox30.Value) 'ces 5 textboxes en AA:AE
End With

Else
MsgBox "problème, It's the first lign"
End If
End With
MsgBox "new signature created!"
UserForm_Initialize
ListBox20.TopIndex = ListBox20.ListCount - 1

End Sub
Private Sub CommandButton8_Click()
Dim ligne As Integer
Dim TS As ListObject
Dim i As Byte

Set TS = Sheets("DATABASE_VUSHF").ListObjects(1)
If ListBox20.ListIndex = -1 Then Exit Sub

'trouver ligne correspondant à combobox1
ligne = WorksheetFunction.Match(ListBox20.List(ListBox20.ListIndex, 0), TS.ListColumns(1).DataBodyRange, 0)

With TS
    For i = 2 To 26 'on part de la combobox2 pour compléter colonnes 2 à 26
        .DataBodyRange(ligne, i).Value = Me.Controls("Combobox" & i).Value
    Next i

    For i = 26 To 30 'compléter colonnes 26 à 30
        .DataBodyRange(ligne, i + 1).Value = Me.Controls("Textbox" & i).Value
    Next i

End With

MsgBox "modification done!"
UserForm_Initialize
ListBox20.TopIndex = ListBox20.ListIndex - 0
End Sub
Private Sub CommandButton14_Click()
     Dim LO

     Set LO = Sheets("DATABASE_VUSHF").Range("Tableau1").ListObject     'ce tableau

     With ComboBox1
          'Debug.Print .Text
          If .Text = "" Then Exit Sub        'si vide, arrête
          r = Application.Match(.Text, LO.ListColumns("ELECTRONIC NAME").DataBodyRange, 0)     'ligne du tableau où ce nom se trouve
          If Not IsNumeric(r) Then MsgBox "Not found !!!???": Exit Sub     'normallement ceci serait impossible
          s = Left(.Value, 8) & Split(.Value, "-")(1) + 1     ' "electronic name" suivant
          r1 = Application.Match(s, LO.ListColumns("ELECTRONIC NAME").DataBodyRange, 0)     'rechercher ce nouveau electronic name
          If IsNumeric(r1) Then MsgBox "This ""Electronic Name"" already exists !!!", vbCritical, s: Exit Sub     'existe déjà = arrête
     End With

     Set c = LO.ListRows.Add(r + 1).Range    'insérer une nouvelle ligne après la ligne actuelle
     c.Value = c.Offset(-1).Value            'copier et coller les données de l'ancienne ligne   >>>> je ne suis pas sû que je peux faire cela, c'est plutôt un exemple
     c.Cells(1).Value = s                    'seulement l' "Electronic Name" est différent

                                  'votre système de mise à jour
     MsgBox "new mode created!"
     UserForm_Initialize
     ListBox20.TopIndex = ListBox20.ListIndex + 1
End Sub

Peut on mettre les lignes en fond de couleur bleu temporairement ?

Pour l'ordre, si c'est de l'alphabet oui mais en alphanumériques le code ne me les range pas' par ordre.

a+

Le 05/10/2023 à 14:36

pour des couleurs temporaire, on peut utiliser des MFCs. Voir PJ, une plage nommée "Ligne_Bleu" dans laquelle on écrit le numéro de la ligne que vous voulez colorer. Puis une MFC pour ce tableau et puis durant une de vos macros des 3 boutons, vous changez la valeur de "Ligne_Bleu" et c'est tout.

Vous faites cela avec une variante d'une de ces lignes dans vos macros 5, 8 ou 14

8draft-avec-listbox1-2.xlsm (79.94 Ko)
Sub Ma_Ligne_Bleu()
     'si vous savez la ligne dans la feuille, ici ligne 10
     Sheets("DATABASE_VUSHF").Range("Ligne_Bleu").Value = 10

     'si vous utilisez le "Listrow" de votre tableau
     Sheets("DATABASE_VUSHF").Range("Ligne_Bleu").Value = Sheets("DATABASE_VUSHF").ListObjects("Tableau1").ListRows(10).Range.Row

     'aucune ligne bleu
     Sheets("DATABASE_VUSHF").Range("Ligne_Bleu").Value = ""
End Sub
Rechercher des sujets similaires à "identifiant unique"