Microsoft 365 Déplacer ligne tableau grâce au SpinButton

bibbip35

XLDnaute Occasionnel
Bonjour à tous

Je souhaiterais déplacer les lignes d'un tableau grâce une listview et un bouton Spin Button
J'ai bien reçu a créer le SpinButton et grace a la réponse de Bqtr dans le post ci-dessous

Mais je n'arrive a répercuter ce déplacement de ligne dans le tableau de la feuille "Planning CMS" du fichier exemple en pièce jointe

Je profite également de ce post pour savoir si il existerai la possibilité de supprimer une ligne également via la listview?

Merci encore pour aide

Bonne soirée

Bibbip
 

Pièces jointes

  • Copie de Planning bibbip - SpinButton.xlsm
    620.8 KB · Affichages: 10

AtTheOne

XLDnaute Impliqué
Supporter XLD
Bonjour à toutes & à tous, bonjour @bibbip35

Le but étant de montrer le fonctionnement du changement de l'ordre dans le tableau structuré avec le SpinButton du formulaire, je n'ai pas repris ton projet en totalité, j'ai fait l'exercice sur le tableau "t_BDD" extrait de ta pièce jointe en remplaçant pas mal de formules par des valeurs.

Dans les formules conservées, j'ai fait des adaptations pour qu'elles soient insensibles à l'ordre (Date début) ou plus simple (Date fin) ou en heure décimale (Ecart H et Gain / Perte H).
(J'ai repris ta fonction DateFin.)

Le projet permet de décaler les lignes sélectionnées (une à une) de la ListView avec action immédiate sur le tableau "t_BDD" et la possibilité de revenir à l'ordre initial (avant l'appel de la macro, ou le dernier enregistrement), ou encore d'enregistrer le nouvel ordre.

Le code du formulaire :
Enrichi (BBcode):
Dim LO As ListObject

Private Sub UserForm_Initialize()
     Ini_LVw
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
     If CloseMode = vbFormControlMenu Then
          If MsgBox("Revenir à ordre initial ? (après le dernier enregistrement)", vbYesNo) = vbYes Then CBn_RàZ_Click
     End If

End Sub

Sub Ini_LVw()
     Dim Echelle As Double, Tb, NbCol As Integer, Frmts(), LoBdDRg1 As Range, Header, i As Long, j As Integer
     'Facteur d'échelle pour la largeur des colonnes
     Echelle = 1
     'ListObject
     Set LO = [t_BDD].ListObject
     'Nom des colonnes dans un tableau
     Header = LO.HeaderRowRange
     'Stockage des valeurs dans un tableau
     Tb = [t_BDD].Value2
     'Nbre de colonne du ListObject
     NbCol = UBound(Tb, 2)
     'Tableau pour stocker les formats
     ReDim Frmts(1 To NbCol)
     'Première ligne de données du ListObject
     Set LoBdDRg1 = [t_BDD].Rows(1)
    
     With Me.LVw_tb
          'Création des entêtes, alignement à droite des dates et des doubles, mémorisation des formats de la 1ère ligne.
          With .ColumnHeaders
               .Clear
               .Add , , "idx", 0
               For i = 1 To NbCol
                    .Add , , Header(1, i), [t_BDD].ListObject.ListColumns(i).Range.Width * Echelle
                    If VarType(LoBdDRg1.Cells(i).Value) = vbDouble Or VarType(LoBdDRg1.Cells(i).Value) = vbDate Then .Item(i + 1).Alignment = lvwColumnRight
                    Frmts(i) = Replace(Replace(Replace(Replace(Replace(LoBdDRg1.Cells(i).NumberFormatLocal, "jj", "dd"), "aaaa", "yyyy"), "Standard", "General"), ",", "."), """", """""")
               Next
          End With
          'Aspect de la Listview
          .View = lvwReport
          .Gridlines = True
          
          .AllowColumnReorder = False
          .FullRowSelect = True
          .LabelEdit = lvwManual
          
          For i = 1 To UBound(Tb)
               'Créations des Items (utilisés comme index) avec une clef type "K00000001" et un Texte type "00000001"
               .ListItems.Add , Format(i, """K""00000000"), Format(i, "00000000")
               With .ListItems(i)
                    'Création des SubItems, avec un format pour les valeurs numériques
                    For j = 1 To UBound(Tb, 2)
                         .ListSubItems.Add , , IIf(IsNumeric(Tb(i, j)), Evaluate("=Text(" & Replace(Tb(i, j), ",", ".") & ",""" & Frmts(j) & """)"), Tb(i, j))
                    Next j
               End With
          Next i
          .HideSelection = False
          'Désélectionner la première ligne
          .ListItems(1).Selected = False
          Set .SelectedItem = Nothing
     End With
    
End Sub

Private Sub CBn_RàZ_Click()
'Remettre dans le même ordre que lors de l'affichage du formulaire ou du dernier enregistrement
     Dim Tb(), i As Long
    
     With Me.LVw_tb
          nbLgn = .ListItems.Count
          .Sorted = False
          ReDim Tb(1 To nbLgn, 1 To 1)
          For i = 1 To nbLgn
               '(mémorisation des clefs dans l'ordre actuel)
               Tb(i, 1) = .ListItems(i).Key
               'Replacer les index (texte des ListItems) par les clefs
               .ListItems(i).Text = .ListItems(i).Key
          Next
          'Tri sur les clefs
          .SortKey = 0
          .Sorted = True
          .Sorted = False
          For i = 1 To nbLgn
               'Actualiser les index
               .ListItems(i).Text = Format(i, "00000000")
          Next
          .SetFocus
          .SelectedItem.EnsureVisible
     End With
     With LO
          'Remettre dans l'ordre initial le ListObject
          'Ajout d'une colonne contenant les clefs
          .ListColumns.Add
          .ListColumns(.ListColumns.Count).DataBodyRange.Value = Tb
          'Tri ascendant sur la colonne ajoutée
          With .Sort
               .SortFields.Clear
               .SortFields.Add Key:=LO.ListColumns(LO.ListColumns.Count).Range, SortOn:=xlSortOnValues, Order:=xlAscending
               .Header = xlYes
               .Apply
          End With
          'Suppression de la colonne ajoutée
          .ListColumns(.ListColumns.Count).Delete
     End With

End Sub

Private Sub CBn_Enregistrer_Click()
'Enregistrer l'ordre actuel de la listview
     If MsgBox("Sauvegarder l'ordre actuel du tableau ?", vbYesNo) = vbYes Then
          Me.LVw_tb.ListItems.Clear
          Ini_LVw
     End If
End Sub

Private Sub SBn_Déplacer_SpinUp()
'Déplacement vers le haut
     Dim N° As Long, Tb, rang As String, i As Long
     N° = Me.LVw_tb.SelectedItem.Index
    
     'bidouille pour conserver le rehaussement en bleu de la ligne sélectionnée
     Me.LVw_tb.SetFocus
     Me.SBn_Déplacer.SetFocus
     Me.LVw_tb.SetFocus
    
     Application.ScreenUpdating = False
     Tb = LO.ListRows(N°).Range.Formula2R1C1Local
     With Me.LVw_tb
          If N° > 1 Then
          'Déplacement vers le haut (diminution de l'index)
               .Sorted = False
               rang = .SelectedItem.Text
               .SelectedItem.Text = Format(CLng(rang) - 1, "00000000")
               .ListItems(N° - 1).Text = rang
               LO.ListRows.Add (N° - 1)
               LO.ListRows(N° - 1).Range.Formula2R1C1Local = Tb
               LO.ListRows(N° + 1).Delete
          Else
          'Déplacement en fin de liste
               .Sorted = False
               .SelectedItem.Text = Format(.ListItems.Count, "00000000")
               For i = 2 To .ListItems.Count
                    .ListItems(i).Text = Format(i - 1, "00000000")
               Next
               LO.ListRows.Add
               LO.ListRows(LO.ListRows.Count).Range.Formula2R1C1Local = Tb
               LO.ListRows(1).Delete
          End If
          'Tri avec les nouveaux index
          .SortKey = 0
          .SortOrder = lvwAscending
          .Sorted = True
          .Sorted = False
          .SelectedItem.EnsureVisible
          .Refresh
     End With
     Application.ScreenUpdating = True
End Sub

Private Sub SBn_Déplacer_SpinDown()
'Déplacement vers le bas
     Dim N° As Long, Tb, rang As String, i As Long
     N° = Me.LVw_tb.SelectedItem.Index
    
     'bidouille pour conserver le rehaussement en bleu de la ligne sélectionnée
     Me.LVw_tb.SetFocus
     Me.SBn_Déplacer.SetFocus
     Me.LVw_tb.SetFocus
    
     Application.ScreenUpdating = False
     Tb = LO.ListRows(N°).Range.Formula2R1C1Local
     With Me.LVw_tb
          If N° < .ListItems.Count Then
          'Déplacement vers le bas
               .Sorted = False
               rang = .SelectedItem.Text
               .SelectedItem.Text = Format(CLng(rang) + 1, "00000000")
               .ListItems(N° + 1).Text = rang
               LO.ListRows.Add (N° + 2)
               LO.ListRows(N° + 2).Range.Formula2R1C1Local = Tb
               LO.ListRows(N°).Delete
          Else
          'Déplacement en tête de liste
               .Sorted = False
               .SelectedItem.Text = "00000001"
               For i = 1 To .ListItems.Count - 1
                    .ListItems(i).Text = Format(i, "00000000")
               Next i
               LO.ListRows.Add 1
               LO.ListRows(1).Range.Formula2R1C1Local = Tb
               LO.ListRows(LO.ListRows.Count).Delete
          End If
          'Tri avec les nouveaux index
          .SortKey = 0
          .SortOrder = lvwAscending
          .Sorted = True
          .Sorted = False
          .SelectedItem.EnsureVisible
          .Refresh
     End With
     Application.ScreenUpdating = True
End Sub

Je te laisse faire les adaptation à ton projet.
Voir PJ

Amicalement
Alain
 

Pièces jointes

  • Déplacer ligne tableau grâce au SpinButton 0.xlsm
    55.9 KB · Affichages: 15

bibbip35

XLDnaute Occasionnel
Bonjour Alain , Bonjour à tous

Merci pour l'aide !!!

Est-ce que par contre il est possible de visualiser dans l'userform le tableau même pour plus de visibilité ?
L'idée serait d'afficher le tableau dans la listview , puis de cliquer sur la ligne en question pour effectuer les deplacement

Merci encore

Bibbip35
 

AtTheOne

XLDnaute Impliqué
Supporter XLD
Bonjour @bibbip35
L'idée serait d'afficher le tableau dans la listview , puis de cliquer sur la ligne en question pour effectuer les deplacement

Euh ... C'est bien ce que ça fait non ?

Regarde la procédure "Ini_LVw" : elle charge dans la ListView le tableau t_BDD en entier.

Ensuite, on sélectionne une ligne dans cette listview, et avec le spinbutton on la déplace vers le haut ou vers le bas (dans la listview), l'action est alors immédiatement répliquée dans la tableau t_BDD...
Enfin c'est comme ça que ça fonctionne chez moi.
Avec la possibilité de revenir à l'ordre initial (avant l'appel de la macro, ou le dernier enregistrement),

Amicalement
Alain
 

bibbip35

XLDnaute Occasionnel
Bonsoir Alain

Tous d'abord , excusez moi pour le retard ... j'étais absent de chez moi pour un we prolongé ;)

Le problème que j'ai et qu'est sans doute liée !?
est que je suis obligé de décoché la reference "Microsoft Windows Common Controls (6.0) SP6'

Et j'ai l’écran suivant d’où ma question

Sinon je dois dire que c'est top ; c'est exactement ce que je voulais !!!

@ Alain , merci encore pour votre aide !!!

Bonne soirée

Bibbip

1654022304008.png
 

AtTheOne

XLDnaute Impliqué
Supporter XLD
Bonsoir @bibbip35

Quand tu ajoutes une Listview dans un userform quelle bibliothèque est cochée ? Dans ton fichier exemple c'est bien Microsoft Windows Common Controls (6.0) SP6 comme dans mon projet,

Sinon dans mon exemple supprime juste la listview "LVw_tb", et recrée en une que tu rebaptiseras "LVw_tb", le pb de référence devrait se régler comme ça.

Amicalement
Alain
 

ChTi160

XLDnaute Barbatruc
Bonsoir le Fil
@bibbip35
J'ai eu le même problème que toi !
j'ai fait la même chose que préconisé par Alain , mais pareil !
je suis allé dans outils /Références et Parcourir pour aller Clicker sur le MSCOMCTL.Ocx
Puis Je me suis demandé , pourquoi
Cette procédure contient ces deux Lignes ?
VB:
Sub Changer_Ordre()
     UsF_Déplacer.Show 'affichage userform
      Unload UsF_Déplacer 'masquer le Userform
End Sub
j'ai supprimé la deuxième Ligne et ça semble fonctionner
Code:
Sub Changer_Ordre()
     UsF_Déplacer.Show 0
End Sub
jean marie
Ps : voir la petite vidéo
 

Pièces jointes

  • Bibbip-1.gif
    Bibbip-1.gif
    879.3 KB · Affichages: 13
Dernière édition:

AtTheOne

XLDnaute Impliqué
Supporter XLD
Bonsoir @ChTi160
Le Unload UsF_Déplacer sert à décharger le formulaire après sa fermeture, je ne pense pas que cela intervienne.
Quand je décoche Microsoft Windows Common Controls (6.0) SP6 j'ai le même phénomène que vous, si je le remets ça refonctionne.
Si je décoche Microsoft Windows Common Controls (6.0) SP6 et que je recrée une listview, cette bibliothèque se réactive...
Peux-tu me dire quelle bibliothèque chez vous définit les objets ListView ?
L'exemple fournit par @bibbip35 fonctionne-t'il chez toi ? si oui avec quelles références ?
Voilà l'aspect de ce que j'ai chez moi

1654026890054.png


Amicalement
Alain
 

AtTheOne

XLDnaute Impliqué
Supporter XLD
Re
Je crois que j'ai trouvé :
Sans Microsoft Windows Common Controls (6.0) SP6, des constantes utilisées ne sont pas définies.

J'utilise lvwReport qui vaut 3, lvwManual qui vaut 1 et lvwAscending qui vaut 0

Dans le code du formulaire replacer dans tout le module (une occurrence pour chaque constatnte)
lvwReport par 3
lvwManual par 1
lvwAscending par 0

De cette façon cela fonctionne

Bon courage
Amicalement
Alain
 

ChTi160

XLDnaute Barbatruc
Re
tu dis :
Le Unload UsF_Déplacer sert à décharger le formulaire après sa fermeture, je ne pense pas que cela intervienne.
Ok ca n'est pas la cause du problème ! mais tu as ces deux Lignes dans le Bouton d'affichage du Userform d'où ma question .
VB:
Sub Changer_Ordre()'Bouton d'affichage du Userform
     UsF_Déplacer.Show  'afficher Userform
'   Unload UsF_Déplacer 'ici on décharge le Userform
End Sub
chez moi si tu Coches le Mscomctl2 Microsoft Windows Common Controls (2 6.0) SP6
et pas le Microsoft Windows Common Controls (6.0) SP6
et bien ca fonctionne avec les
vwReport
lvwManual
lvwAscending

Version : voir image pour la version
Bonne fin de Soirée
Jean marie
 

Pièces jointes

  • Alain-5.gif
    Alain-5.gif
    111.5 KB · Affichages: 17
Dernière édition:

Discussions similaires

Membres actuellement en ligne

Statistiques des forums

Discussions
311 725
Messages
2 081 941
Membres
101 847
dernier inscrit
Djigbenou