Sélection dans listview

Bonsoir a toutes et tous, forum bonsoir



J'ai sous Excel 2007 VBA un UserForm avec une listview2

Dans cette Listview2, une liste de vidéos avec case a cocher en face de chaque vidéo.

Lorsque je clic dans une case celle ci se coche sélectionne la vidéo et lance le lecteur windows média player.

Ma question : Si cette vidéo que je viens de prévisualiser disons que je souhaite l'attribuer a un boutton, Label ou autre.

Si elle me plait, je clic sur le label et je l'envoie se copier sur mon disque dur de ma Freebox afin de regarder cette sur mon grand écran.

Car je ne veux pas envoyer a chaque les vidéos sur le DD Freebox ,juste uniquement par choix

l'adresse DD FREEBOX est

"\\FREEBOX\Disque dur"

Merci a vous et de votre aide et de votre savoir

bonne soirée a tous merci

Cordialement Ray

12 réponses

  1. Bonjour dudulle76120,

    Un label ou autre compère est un contrôle supplémentaire, qui plus est, répété autant de fois qu'il existe des vidéo sur la liste.

    Une idée, juste comme ça:
    Double click sur la ligne de la ListView = visionner cette vidéo
    Case à cocher à True = enregistrer cette vidéo sur la Box

    Qu'en pensez-vous ?
    1. Alors, le soucis est que je n'ai pas le classeur pour faire des tests.

      Donc, sans le classeur:
      Il faut créer un évènement "Doubleclick" sur item de ta "G_Listing.ListView2" .. c'est dans cet évènement que tu fait appel à "Lire la vidéo".
      Tu me suis toujours ?

      Il faut mettre quelque part sur ton formulaire, un bouton.
      Tu le renomme, par exemple "btn_Save".
      Tu "DoubleClique" sur ce bouton .. Visual Basic te crée un évènement .. Dans cet évènement, il faut placer le code de copie de vidéos
      Dim i As Integer
      '
      POUR i=0 ; i<ListView.Count ; i++
      	SI CaseACocher(i) == VRAI ALORS
      		COPIER FICHIER DE ... VERS ...
      	FIN SI
      FIN POUR i

      code pour copier un fichier d'un endroit vers un autre :
      Const OverwriteExisting = True
      Set objFSO = CreateObject("Scripting.FileSystemObject")
      objFSO.CopyFile "CheminDeDépart\FichierOrigine.avi" , "CheminFinal\", OverwriteExisting
      1. Bonsoir dudulle76120,
        Avec ton code, on peut peut-être t'aider .. sans lui, cela devient difficile!
        1. Bonjour heliotte, bonjour forum

          Merci pour ta réponse, désolé (je le sais bien en plus) pour cet oubli.

          Voici donc le bout de code qui me permets de lire une vidéo lorsque je coche le titre d'une vidéo dans la listview2

          Bonne semaine et merci de m'avoir lu

          Cordialement Ray

          Option Explicit
          Public MeHwnd As Long
          Const GWL_EXSTYLE As Long = (-20)                 'APIs gestion des fenêtres transparentes
          Const WS_EX_LAYERED As Long = &H80000
          Const LWA_ALPHA As Long = &H2                     'Pas utilisé Const LWA_COLORKEY As Long = &H1
          
          Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
          Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
          Private Declare Function SetLayeredWindowAttributes Lib "user32" _
                                              (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Long, ByVal dwFlags As Long) As Long
          
          'Pour excel ou word, FindWindow. afin de déterminer l'handle de la fenêtre
          Private Declare Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
          
          Private Sub UserForm_Initialize()
          Dim FilmSelection As String
          G_Listing.TextBox5 = ""
          'Film sélectionné dans la listview listview2 de l'userform G_Listing
          FilmSelection = G_Listing.ListView2.ListItems.Item(G_Listing.ListView2.SelectedItem.Index)
          WindowsMediaPlayer1.URL = "E:\Videos\" & FilmSelection & ".avi"    'On lance la vidéo sélectionnée
          
          Me.Caption = FilmSelection
          
          'REND TRANSPARENT LA FENETRE DE L'USERFORM
          MeHwnd = FindWindowA(vbNullString, Me.Caption)                                               'Recupere le handle de la fenêtre
          SetWindowLong MeHwnd, GWL_EXSTYLE, GetWindowLong(MeHwnd, GWL_EXSTYLE) Or WS_EX_LAYERED       'Rajoute l'attribut transparent à la fenêtre
          SetLayeredWindowAttributes MeHwnd, 0, 0, LWA_ALPHA             'Définie la transparence de la fenêtre 0 = Taux de transparence de 0 à 255
          End Sub
          
          '### AFFICHAGE DU MESSAGE "WMP Arrêté" LORS DE LA FERMETURE DE L'USERFORM LecteurWindowsMedia QUI CONTIENT LE CONTROLE WindowsMediaPlayer1
          Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
          G_Listing.TextBox5 = "WMP arrêté"
          End Sub
          
          'ON REND LA FENÊTRE DE L'USERFORM LecteurWindowsMedia TRANSPARENTE LORSQUE
          'LA VIDEO EST EN COURS DE LECTURE (3) OU EN PREPARATION D'UNE NOUVELLE SEQUENCE DE LECTURE (9)
          Private Sub WindowsMediaPlayer1_PlayStateChange(ByVal NewState As Long)
          If NewState = 3 Or 9 Then
          MeHwnd = FindWindowA(vbNullString, Me.Caption)                                           'Recupere le handle de la fenêtre
          SetWindowLong MeHwnd, GWL_EXSTYLE, GetWindowLong(MeHwnd, GWL_EXSTYLE) Or WS_EX_LAYERED   'Rajoute l'attribut transparent à la fenêtre
          SetLayeredWindowAttributes MeHwnd, 0, 255, LWA_ALPHA             'Définie la transparence de la fenêtre 255 = Taux de transparence de 0 à 255
          End If
          End Sub
          
          '### Pour faire clignoter le message "WMP arrèté" lorsque le lecteur WMP est fermé
          Private Sub UserForm_Terminate()
          Dim A As Single, B As Integer
          On Error Resume Next
          A = Timer
          Do
          B = B + 1
          Do Until A + 0.5 <= Timer
          DoEvents
          Loop
          If G_Listing.TextBox5 = "WMP arrêté" Then G_Listing.TextBox5 = "" Else G_Listing.TextBox5 = "WMP arrêté"
          A = Timer
          If G_Listing.ActiveControl.Name = "Frame2" Then
          If G_Listing.Frame2.ActiveControl.Name = "BtnQuitter" Then G_Listing.TextBox5 = "": Exit Sub
          End If
          Loop Until B = 12    'Message "WMP arrêté" clignotera 12/2=6 fois
          End Sub
          
          
          1. Salut héliotte

            Merci pour cette réponse mais pour etre sincère je ne vois pas trop comment faire

            pour envoyer une vidéo si le choix me plait vers "\\FREEBOX\Disque dur"

            Bon bien sur tu a raison si je dois mettre autant de Label ou autre sur chaque vidéo

            l'userform principal va vite deborder

            Merci je continue de chercher une solution, bonne journée

            Cdlt Ray
            1. Rebonjour Ray,
              Je pense que cette solution est plus interactive .. je t'explique
              Imagine .. Tu as ta liste devant toi, tu double-clique sur un "lien" .. la vidéo se met en route .. Non, elle ne me plaît pas plus que ça ... etc ... la vidéo n° 14 me plaît > je coche ... la vidéo n° 15 me plaît > je coche ... la vidéo n° 23 me plaît > je coche ... la vidéo n° 31 me plaît > je coche.
              Fini le voir les vidéo.
              Je clique sur un dernier bouton qui copie les vidéos vers l'endroit que tu désire ("\\FREEBOX\Disque dur" ) et décoche les vidéo transférées ou supprime les éléments de la liste (à toi de choisir!).
              Je trouve cette solution pratique, pas toi ?
          2. Re salut heliotte

            j'ai chercher a comprendre pour suivre ton idée mais je vois pas comment coder pour que ca fonctionne.

            Une idée, juste comme ça:
            Double click sur la ligne de la ListView = visionner cette vidéo
            Case à cocher à True = enregistrer cette vidéo sur la Box


            Merci de ton aide

            Cdlt Ray
            1. Salut

              merci pour ta reponse les messages se sont croissés
              je veux bien faire l'essai ca me parait pas mal

              ton raisonnement me va bien mais pour le code, la je ne sait pas

              merci désolé pour le croissement

              j'ai oublier de dire que je ne pouvais cocher qu'une video a la fois
              des que j'en coche une autre la précédente se décoche et ainsi de suite

              Ray
              1. Salut héliotte

                merci pour le code

                alors j'ai créer un évènement dans G_Listing.Listview2
                et un commandboutton (baptiser Btn_save) dans L'userform G_Listing

                je ne comprends pas ce code je suis en VBA pas en VB

                POUR i=0 ; i<ListView.Count ; i++
                	SI CaseACocher(i) == VRAI ALORS
                		COPIER FICHIER DE ... VERS ...
                	FIN SI
                FIN POUR i
                


                et le code si dessous je dois le mettre où svp

                Const OverwriteExisting = True
                Set objFSO = CreateObject("Scripting.FileSystemObject")
                objFSO.CopyFile "CheminDeDépart\FichierOrigine.avi" , "CheminFinal\", OverwriteExisting
                


                Pour le chemin j'ai compris

                Merci a toi

                Ray
                1. Cher Ray,
                  Ceci : et le code si dessous je dois le mettre où svp est le code qui copie un fichier d'un endroit à un autre et est à placer à l'intérieur du code juste avant, à la place de COPIER FICHIER DE ... VERS ...
                  Et justement, ce code est en langage procédural, une sorte de français technique..
                  Comme je n'ai pas le fichier, j'ai préféré l'écrire en langage procédural, voilà.
                  Maintenant, je peux te l'écrire directement dans le fichier, moyennant que tu dépose ce fichier sur un site de stockage, tel que https://www.cjoint.com/ Après quoi tu mets le lien dans ton prochain message, histoire de pouvoir le récupérer.
                  Attention de ne pas laisser de données sensibles dans le fichier !
                  Cordialement, Heliotte
              2. Salut

                J'ai bien compris mais le programme n'étant pas tout de moi
                il se fait que ce n'ai pas très bien structurer au niveau de l'ensemble du code

                il me fait te joindre un minimum d'explications sur son fonctionnement

                j'aurai préférer pas MP mais je ne sais pas comment on fait sur ce site

                je te joint le bout de code qui gère la Listview2

                j'espère que ca t'aidera

                merci bien pour ton aide

                Ray

                '### GESTION DU CLIC DANS LA LISTVIEW2
                Private Sub ListView2_Click()
                  Dim Chemin As String, Fichier As String, FichierTemp As String, TitreFichier As String, FilmSelection As String
                  Dim Fs As FileSystemObject, Dossier As Folder, F As File, Img As Object, IP As Object
                  Dim Cpt As Integer, LstItem As ListItem
                
                  With ListView2
                    On Error Resume Next                                         'Si aucune ligne est sélectionnée dans la listview on sort
                    Set LstItem = .SelectedItem
                    On Error GoTo 0
                    If LstItem Is Nothing Then Exit Sub
                    FilmSelection = .ListItems.Item(.SelectedItem.Index)
                
                    Label25 = FilmSelection                                      'Affiche le nom du film sélectionné dans le label 25
                
                    Chemin = "E:\Videos\"
                    Fichier = "E:\Affiche\" & FilmSelection & ".jpg"
                    Set Fs = CreateObject("Scripting.FileSystemObject")
                    Set Dossier = Fs.GetFolder("E:\Affiche")
                    For Each F In Dossier.Files
                      If F.Name = FilmSelection & ".jpg" Then Cpt = 1
                    Next
                
                    'DIMENSIONNEMENT DE L'IMAGE POUR QU'ELLE ENTRE DANS L'USERFORM imageFilm
                    Set Img = CreateObject("WIA.ImageFile")                      'Création conteneur pour l'image à manipuler
                    Set IP = CreateObject("WIA.ImageProcess")                    'Création du gestionnaire de filtre
                    Fichier = IIf(Cpt = 0, "E:\Affiche\Liberty.jpg", Fichier)    'Si l'affiche n'existe pas on prend l'affiche Liberty.jpg par défaut
                    Img.LoadFile Fichier                                         'Chargement de l'image dans le conteneur
                    IP.Filters.Add IP.FilterInfos("Scale").FilterID              'Ajoute le filtre pour redimensionner l'image (Scale)
                    IP.Filters(1).Properties("MaximumWidth") = 315               'Définit la largeur maxi pour le redimensionnement
                    IP.Filters(1).Properties("MaximumHeight") = 375              'Définit la hauteur maxi pour le redimensionnement
                    IP.Filters(1).Properties("PreserveAspectRatio") = False      'Ne garde pas les proportions
                
                    Set Img = IP.Apply(Img)                                      'Application du filtre à l'image
                    FichierTemp = "E:\Affiche\temp$$$$.jpg"                      'Crée une image temporaire pour l'afficher dans l'userform imageFilm
                    'Donne un nom (temp$$$$.jpg) dont on est sûr qu'il n'est et ne sera pas utilisé
                    On Error Resume Next
                    Kill FichierTemp                                             'Supprime l'image temp$$$$.jpg si elle existe
                    On Error GoTo 0
                    Img.SaveFile FichierTemp                                     'Sauvegarde le fichier
                    TitreFichier = Split(IIf(Cpt = 0, "Liberty.jpg", FilmSelection & ".jpg"), ".")(0)
                
                    With imageFilm
                      .Show
                      .Caption = TitreFichier
                      .Picture = LoadPicture(FichierTemp)
                    End With
                    Kill FichierTemp                                             'Suppression de l'image temp$$$$.jpg en fin de macro
                
                '### Appel du film choisi dans la Listview2
                    LecteurWindowsMedia.Show
                  End With
                End Sub
                
                Private Sub ListView2_ItemCheck(ByVal Item As MSComctlLib.ListItem)
                  With ListView2
                    .ListItems(Item.Index).Selected = True
                    For i = 1 To .ListItems.Count
                      If i <> Item.Index Then .ListItems(i).Checked = False
                    Next i
                  End With
                End Sub
                
                Private Sub ListView2_ItemClick(ByVal Item As MSComctlLib.ListItem)
                  Item.Checked = True
                  With ListView2
                    For i = 1 To .ListItems.Count
                      If i <> Item.Index Then .ListItems(i).Checked = False
                    Next i
                  End With
                End Sub
                
                1. C'est peu-têtre pas facile pour toi, mais, quitte à me répéter, j'ai beaucoup plus facile avec un classeur.
                2. Comment déposer un fichier sur le site de stockage "cjoint.com":

                  - Vérifier que le ou les fichiers ne contiennent aucune données sensible !
                  - Se rendre sur la page d'accueil du site https://www.cjoint.com/
                  - Rechercher le fichier à déposer.
                  - Le mettre en "Private".
                  - Cliquer sur le bouton "Créer le lien".
                  - Dans la nouvelle page, cliquer sur le lien pour vérifier que le téléchargement fonctionne correctement.
                  - Copier l'adresse de la page, et, pour finir, coller ce lien dans le prochain message.
              3. RE

                Et par message privé ça te dit, si je t'en dirai plus long
                1. Cela devrait pouvoir se faire puisque le lien n'est que du texte. Donc, j'aurai tout de même accès au fichier.
              4. je t'envoi mon adresse mail comment svp
                je ne sais pas sur ce site
                1. Pas par mail s'il te plait.
                  Il existe un outil fort sympathique ressemblant à la messagerie instantanée.
                  Tu clique sur mon pseudo,
                  dans la page qui s'ouvre, tu trouveras : "message privé" ..
                  et on communique via ce canal.
                  Mais attention, je donnerais toujours la priorité au forum, dans le sens où, nous nous devons d'apporter la connaissance au forum, donc à tout un chacun.
                  En d'autres termes, si je considère que ce que je vais t'écrire peux être lu par tout le monde, je passerais bien sûr par le canal normal du forum. Par contre si je considère que c'est confidentiel, je t'écrirais par cette technique privée.
                  Pour en finir, dans de rares cas où c'est indéfinissable, d'abord je t'écriais en privé.
                  Si tu accepte ces conditions, alors à très bientôt, heliotte.
                2. Bien recu j'ai bien compris

                  la question n'ai pas de ne pas partager au contraire, mais parfois il vaut mieux s'abstenir de crier sur tous les toits.

                  bon c'est pas grave, je te remercie beaucoup pour ton aide

                  je vais refaire des essais

                  Cdlt Ray
                3. Comme tu veux Ray.
                  @ très bientôt, Heliotte
              5. je sais faire sur ci-joint mais je prefere que mon fichier ne t'arrive que a toi

                c'est pour cela que je voulais t'envoyer mon mail