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. 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
    1. 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
    2. 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.
    3. 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.
    4. 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
    5. 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. 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. 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 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. 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. 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. Bonsoir dudulle76120,
                Avec ton code, on peut peut-être t'aider .. sans lui, cela devient difficile!