Microsoft 365 ListBox - colonne Lien Hypertexte

Scorpio

XLDnaute Impliqué
Bonjour à tous,
J'ai récupéré ce travail dans le Forum, et j'aimerais, car je ne suis pas un champion VBA, faire une correction.
En fait, j'ajoute dans la colonne "E", de la feuil1, des liens hypertextes, et, lorsque je fait le transfert dans la feuille "Transfert",
le lien ne suis pas, il n'est plus un lien, voilà.
Est-ce qu'un membre pourrais juste, s'il vous plaît, me dépanner.
Je vous en remercie et à ++++
 

Pièces jointes

  • USF_ListBoxMultiSelect.xlsm
    37.5 KB · Affichages: 13

Scorpio

XLDnaute Impliqué
Re bonjour job75,
J'ai juste constaté 1 petit souci, par ex, je sélectionne 2 ou 3 lignes par ex: année 2001, je choisi la feuille de destination et clic.
Les 2 ou 3 lignes sont transférées, mais n'ont pas les 2 ou 3 ligne l'année 2001.
Il y a 2001, 2001, et 2006, et même chose pour d'autres date.
 

job75

XLDnaute Barbatruc
Oui la macro précédente ne va pas mais il faut maintenir la sélection multiple, c'est plus logique.

Dans ce fichier (2) on revient au Dictionary rendu possible par une boucle inversée :
VB:
Private Sub CommandButton3_Click() 'Transfert ligne par ligne sur feuille choisie
Dim d As Object, i&, x$, ligne&, lig&
Set d = CreateObject("Scripting.Dictionary")
With [Tableau1]
    For i = 1 To .Rows.Count
        x = .Cells(i, 1) & .Cells(i, 2) & .Cells(i, 3) & .Cells(i, 4) & .Cells(i, 5)
        If Not d.exists(x) Then d(x) = i 'mémorise la ligne
    Next
End With
For i = 1 To 9
    If Me("OptionButton" & i) Then Exit For
Next
If i = 10 Then MsgBox "Choisissez une feuille pour le transfert...": Exit Sub
With Sheets(Me("optionButton" & i).Caption)
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    ligne = .Range("A" & .Rows.Count).End(xlUp).Row + 1 '1ère ligne vide
    lig = ligne
    For i = ListBox1.ListCount - 1 To 0 Step -1 'boucle en remontant
        If ListBox1.Selected(i) Then
            With ListBox1: x = .List(i, 0) & .List(i, 1) & .List(i, 2) & .List(i, 3) & .List(i, 4): End With
            If d.exists(x) Then
                [Tableau1].Rows(d(x)).Copy
                .Rows(lig).Insert xlDown 'insère les cellules copiées
                [Tableau1].Rows(d(x)).Delete xlUp 'supprime la ligne
                ligne = ligne + 1
            End If
        End If
    Next
    .Cells(ligne, 2) = "Total"
    .Cells(ligne, 3) = "=SUM(C1:C" & ligne - 1 & ")"
    .Cells(ligne, 3).NumberFormat = "#,##0.00"
    .Cells(ligne, 2).Resize(, 2).Font.Bold = True 'gras
    .Visible = xlSheetVisible 'si la feuille est masquée
    Application.GoTo .[A1]
End With
Unload UserForm1
End Sub
 

Pièces jointes

  • ListBoxMultiSelect(2).xlsm
    56.2 KB · Affichages: 7

Scorpio

XLDnaute Impliqué
Re, job75
OK, pour moi ça fonctionne, super, merci job75

Je prévois aussi ajouter dans la colonne "A", une liste déroulante.
Et, je sais que lorsqu'on fait le transfert de ligne, la liste déroulante suit sur la feuille de transfert.
Serait-t-il encore possible d'adapter la colonne "A" pour que il soit transférer que les données.
A +++job75
 

job75

XLDnaute Barbatruc
Eh bien non, le fichier (2) ne va pas quand il y a des doublons.

En Feuil1 déplacez la ligne 42 (qui est un doublon) au-dessus de la ligne 30

Puis filtrez sur l'année 2001 et transférez en Feuil3 les lignes, on récupère l'année 1983...

Le Dictionary ne va donc pas, alors voyez ce fichier (3) et la macro :
VB:
Private Sub CommandButton3_Click() 'Transfert ligne par ligne sur feuille choisie
Dim tablo(), ub&, i&, ligne&, lig&, x$, j&
With [Tableau1]
    ReDim tablo(1 To .Rows.Count, 1 To 1)
    ub = UBound(tablo)
    For i = 1 To ub
        tablo(i, 1) = .Cells(i, 1) & .Cells(i, 2) & .Cells(i, 3) & .Cells(i, 4) & .Cells(i, 5)
    Next
End With
For i = 1 To 9
    If Me("OptionButton" & i) Then Exit For
Next
If i = 10 Then MsgBox "Choisissez une feuille pour le transfert...": Exit Sub
With Sheets(Me("optionButton" & i).Caption)
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    ligne = .Range("A" & .Rows.Count).End(xlUp).Row + 1 '1ère ligne vide
    lig = ligne
    For i = ListBox1.ListCount - 1 To 0 Step -1 'boucle en remontant
        If ListBox1.Selected(i) Then
            With ListBox1: x = .List(i, 0) & .List(i, 1) & .List(i, 2) & .List(i, 3) & .List(i, 4): End With
            For j = ub To 1 Step -1 'boucle en remontant
                If tablo(j, 1) = x Then Exit For
            Next
            If j <= ub Then
                [Tableau1].Rows(j).Copy
                .Rows(lig).Insert 'insère les cellules copiées
                .Cells(lig, 1).Validation.Delete 'supprime la liste de validation éventuelle
                [Tableau1].Rows(j).Delete xlUp 'supprime la ligne
                tablo(j, 1) = Chr(1) 'neutralise la ligne du tableau
                ligne = ligne + 1
            End If
        End If
    Next
    .Cells(ligne, 2) = "Total"
    .Cells(ligne, 3) = "=SUM(C1:C" & ligne - 1 & ")"
    .Cells(ligne, 3).NumberFormat = "#,##0.00"
    .Cells(ligne, 2).Resize(, 2).Font.Bold = True 'gras
    .Visible = xlSheetVisible 'si la feuille est masquée
    Application.GoTo .[A1]
End With
Unload UserForm1
End Sub
Maintenant les doublons sont traités correctement, re-testez avec l'année 2001.

Les éventuelles listes de validation en colonne A sont supprimées dans les 2 cas de transfert.
 

Pièces jointes

  • ListBoxMultiSelect(3).xlsm
    56.8 KB · Affichages: 8

Scorpio

XLDnaute Impliqué
Re, job75,
Quel travail extraordinaire tu as fait, c'est super, je te remercie grandement.
C'est du boulot de pro tous ça.
Magnifique, je suis content, parce que je me retrouve avec un excellent outil de travail, et je te
remercie.
Prenez bien soins de vous avec cette pandémie de virus, et à un de ces jour
Merci beaucoup job75, a bientôt
 

job75

XLDnaute Barbatruc
Bonjour Scorpio, le forum,

Dans ce fichier (4) voici une solution bien plus rapide et indispensable sur un très grand tableau.

Elle consiste à ajouter une colonne A (masquée) avec la numérotation des lignes dans UserForm_Initialize :
VB:
  NomTableau = "Tableau1"
  Set Rng = Range(NomTableau)
  Rng(1) = 1
  Rng.Columns(1).DataSeries 'numérotation en colonne A masquée
Les macros des boutons sont alors nettement plus simples :
Code:
Private Sub CommandButton2_Click() 'Transfert en bloc
Dim ligne&, i&
ligne = 2
With Sheets("Transfert")
    .Range("A2:E" & .Rows.Count).Clear
    For i = 0 To ListBox1.ListCount - 1
        Range(NomTableau).Rows(ListBox1.List(i, 0)).Copy .Cells(ligne, 1)
        .Cells(ligne, 2).Validation.Delete 'supprime la liste de validation éventuelle en colonne B
        ligne = ligne + 1
    Next
    .Cells(ligne, 3) = "Total"
    .Cells(ligne, 4) = "=SUM(D1:D" & ligne - 1 & ")"
    .Cells(ligne, 4).NumberFormat = "#,##0.00"
    .Cells(ligne, 3).Resize(, 2).Font.Bold = True 'gras
    .Visible = xlSheetVisible 'si la feuille est masquée
    Application.GoTo .[A1], True
End With
Unload UserForm1
End Sub

Private Sub CommandButton3_Click() 'Transfert ligne par ligne sur feuille choisie
Dim i&, ligne&, lig&, j&
For i = 1 To 9
    If Me("OptionButton" & i) Then Exit For
Next
If i = 10 Then MsgBox "Choisissez une feuille pour le transfert...": Exit Sub
With Sheets(Me("optionButton" & i).Caption)
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    ligne = .Range("B" & .Rows.Count).End(xlUp).Row + 1 '1ère ligne vide
    lig = ligne
    For i = ListBox1.ListCount - 1 To 0 Step -1 'boucle en remontant
        If ListBox1.Selected(i) Then
            j = ListBox1.List(i, 0)
            Range(NomTableau).Rows(j).Copy
            .Cells(lig, 1).Insert 'insère les cellules copiées
            .Cells(lig, 2).Validation.Delete 'supprime la liste de validation éventuelle en colonne B
            Range(NomTableau).Rows(j).Delete xlUp 'supprime la ligne
            ligne = ligne + 1
        End If
    Next
    .Cells(ligne, 3) = "Total"
    .Cells(ligne, 4) = "=SUM(D1:D" & ligne - 1 & ")"
    .Cells(ligne, 4).NumberFormat = "#,##0.00"
    .Cells(ligne, 3).Resize(, 2).Font.Bold = True 'gras
    .Visible = xlSheetVisible 'si la feuille est masquée
    Application.GoTo .[A1], True
End With
Unload UserForm1
End Sub
A+
 

Pièces jointes

  • ListBoxMultiSelect(4).xlsm
    56.9 KB · Affichages: 4
Dernière édition:

Scorpio

XLDnaute Impliqué
A oui, j'ai remarqué après plusieurs essais, ça peut être utile plus tard.

Mais, après réflexion, il y a quelques choses qui me perturbe dans le formulaire,
C'est que les colonnes sont jamais en face des titres de colonne, donc dans le formulaire.
 

Discussions similaires

Réponses
7
Affichages
436

Statistiques des forums

Discussions
311 733
Messages
2 082 008
Membres
101 864
dernier inscrit
elrecruiter