XL 2019 code pour tous les disques

[lynyrd]

Bonjour le forum
Existe t'il un moyen pour que l'on puisse se servir de l'userform sur tous les disques dur que le "K"
merci.

Option Explicit             'oblige à déclarer toutes les variables
Option Compare Text         'utilise le texte pour le classement alphabétique
Private x As Variant        'déclare la variable x
Private pl As Range         'déclare la variable pl (PLage)
Private cel As Range        'déclare la variable cel (CELlule)
Private nl As Long          'déclare la variable nl (Numéro de Lige)


Private Sub userform_initialize()
TextBox14.Value = Sheets("feuil1").Range("n2")
Call obG1
End Sub
Private Sub OptionButton1_Click()
Call obG1
End Sub
Private Sub OptionButton2_Click()
Call obG1
End Sub
Private Sub OptionButton3_Click()
Call obG2
End Sub
Private Sub OptionButton4_Click()
Call obG2
End Sub
Private Sub OptionButton5_Click()
Call obG3
End Sub



Private Sub ComboBox1_DropButtonClick()
If Me.ComboBox1.ListCount = 0 Then
    MsgBox "Vous devex choisir le type de recherche ! PAR TITRE,GENRE ou REALISATEUR."
    Me.OptionButton3.SetFocus
End If
End Sub
Private Sub ComboBox1_Change()
  Me.ListBox1.Clear
  For Each cel In pl
    If CStr(cel.Value) = CStr(Me.ComboBox1.Value) Then
      nl = cel.Row
      With Me.ListBox1
        .AddItem Sheets("Feuil1").Cells(cel.Row, 1)
        .List(.ListCount - 1, 1) = Sheets("Feuil1").Cells(nl, 2)
        .List(.ListCount - 1, 2) = nl
      End With
    End If
  Next cel
  If Me.ListBox1.ListCount = 1 Then Me.ListBox1.ListIndex = 0
End Sub

Private Sub listbox1_Click()
Dim Chemin As String
Dim Chemin1 As String
Dim Chemin2 As String
Dim Chemin3 As String
Dim Chemin4 As String
Dim Chemin5 As String



' ****************************************************
' Indiques exactement le répertoire de tes images
' ****************************************************
Chemin = "K:\videotheque\affiches\"
Chemin1 = "K:\videotheque\drapeaux\"
Chemin2 = "K:\videotheque\acteurs\"
Chemin3 = "K:\videotheque\acteurs1\"
Chemin4 = "K:\videotheque\acteurs2\"
Chemin5 = "K:\videotheque\windows\"







For x = 0 To 13
  Next x
 Me.Image1.Picture = LoadPicture(Chemin & Me.ListBox1 & ".jpg")
       Me.Image2.Picture = LoadPicture(Chemin1 & Me.ListBox1 & ".gif")
       Me.Image3.Picture = LoadPicture(Chemin2 & Me.ListBox1 & ".jpg")
       Me.Image4.Picture = LoadPicture(Chemin3 & Me.ListBox1 & ".jpg")
       Me.Image5.Picture = LoadPicture(Chemin4 & Me.ListBox1 & ".jpg")
       Me.WindowsMediaPlayer1.Url = (Chemin5 & Me.ListBox1 & ".mp4")
      
        
      
        
      
  nl = Me.ListBox1.Column(2, Me.ListBox1.ListIndex)
  For x = 0 To 12
    Me.Controls("TextBox" & x + 1).Value = Sheets("Feuil1").Cells(nl, 1 + x)
    Next x
    With Me.TextBox1
      .SelStart = 0
    .SelLength = Len(.Value)
 End With
End Sub
Private Sub CommandButton1_Click()
Dim dest As Range
With Sheets("Feuil1")
    If nl = 0 Then
      
        Set dest = .Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0)
    Else
        Set dest = .Cells(nl, 1)
    End If
End With
For x = 1 To 12
     dest.Value = Me.Controls("TextBox1").Value
     dest.Offset(0, x).Value = Me.Controls("TextBox" & x + 1).Value
 Next x
Unload Me
UserForm1.Show
End Sub
Private Sub CommandButton2_Click()
Unload Me
End Sub
Private Sub obG1()
UserForm1.Frame2.Visible = UserForm1.OptionButton2.Value
If Me.OptionButton1.Value = True Then
    For x = 1 To 13
        Me.Controls("TextBox" & x).Value = ""
    Next x
    Me.TextBox1.SetFocus
    nl = 0
End If
End Sub
Private Sub obG2()
Dim col As Variant
Dim dico As Object
Dim tbl As Variant
Dim I As Variant
Dim j As Variant
Dim temp As Variant

UserForm1.ComboBox1.Clear
col = IIf(UserForm1.OptionButton3.Value = True, 1, 10)
With Sheets("Feuil1")
    Set pl = .Range(.Cells(2, col), .Cells(Application.Rows.Count, col).End(xlUp)) 'définit la plage pl
End With

Set dico = CreateObject("scripting.dictionary")
For Each cel In pl
    dico(cel.Value) = ""
Next cel
tbl = dico.keys

For I = 0 To UBound(tbl, 1)
For j = 0 To UBound(tbl, 1)
        If tbl(I) < tbl(j) Then
            temp = tbl(I)
            tbl(I) = tbl(j)
            tbl(j) = temp
        End If
    Next j
Next I
UserForm1.ComboBox1.List = tbl
End Sub

Private Sub obG3()
Dim col As Variant
Dim dico As Object
Dim tbl As Variant
Dim I As Variant
Dim j As Variant
Dim temp As Variant

UserForm1.ComboBox1.Clear
col = IIf(UserForm1.OptionButton3.Value = True, 1, 5)
With Sheets("Feuil1")
    Set pl = .Range(.Cells(2, col), .Cells(Application.Rows.Count, col).End(xlUp)) 'définit la plage pl
End With

Set dico = CreateObject("scripting.dictionary")
For Each cel In pl
    dico(cel.Value) = ""
Next cel
tbl = dico.keys

For I = 0 To UBound(tbl, 1)
For j = 0 To UBound(tbl, 1)
        If tbl(I) < tbl(j) Then
            temp = tbl(I)
            tbl(I) = tbl(j)
            tbl(j) = temp
        End If
    Next j
Next I
UserForm1.ComboBox1.List = tbl
End Sub

 

[AtTheOne]

Bonjour à toutes & à tous, bonjour @lynyrd
Sans le Userform, difficile de faire plus que ceci :
Un exemple pour parcourir tous les unités actives et indiquer si les répertoires cherchés existent sur ces unités :

Option Explicit

Const Chemin0$ = "\videotheque\affiches\"
Const Chemin1$ = "\videotheque\drapeaux\"
Const Chemin2$ = "\videotheque\acteurs\"
Const Chemin3$ = "\videotheque\acteurs1\"
Const Chemin4$ = "\videotheque\acteurs2\"
Const Chemin5$ = "\videotheque\windows\"


Sub Parcourir_Unités()
    
     'Dim Fso As New FileSystemObject, U As Scripting.Drives, D As Scripting.Drive '(si Microsoft Scripting.Runtime Activé dans les références)
     Dim Fso As Object, U As Object, D As Object 'Sans activer Microsoft Scripting.Runtime
    
     Dim Rép0$, Rép1$, Rép2$, Rép3$, Rép4$, Rép5$
    
     Set Fso = CreateObject("Scripting.FileSystemObject")
    
     Set U = Fso.Drives                 'Liste des Unités de ce PC
     For Each D In U                    'Pour chaque unités
          If D.IsReady Then             'Si l'unité est disponible
               Rép0 = D.Path & Chemin0
               Rép1 = D.Path & Chemin1
               Rép2 = D.Path & Chemin2
               Rép3 = D.Path & Chemin3
               Rép4 = D.Path & Chemin4
               Rép5 = D.Path & Chemin4
               'Indiquer si les répertoires existent
               MsgBox "Disque " & D.DriveLetter & Chr(10) _
                                                & Chr(10) & Chr(9) & Rép0 & Chr(9) & " Existe : " & Fso.FolderExists(Rép0) _
                                                & Chr(10) & Chr(9) & Rép1 & Chr(9) & " Existe : " & Fso.FolderExists(Rép1) _
                                                & Chr(10) & Chr(9) & Rép2 & Chr(9) & " Existe : " & Fso.FolderExists(Rép2) _
                                                & Chr(10) & Chr(9) & Rép3 & Chr(9) & " Existe : " & Fso.FolderExists(Rép3) _
                                                & Chr(10) & Chr(9) & Rép4 & Chr(9) & " Existe : " & Fso.FolderExists(Rép4) _
                                                & Chr(10) & Chr(9) & Rép5 & Chr(9) & " Existe : " & Fso.FolderExists(Rép5)
          End If
     Next

End Sub

Voir pièce jointe
A bientôt

 

[Valtrase]

Bonjour à tous,
Pour moi le plus simple consisterait à créer un champ nommé dans Excel par Exemple : "LybraryPath"
au début du programme tester si sa valeur est vide si oui utiliser : Application.FileDialog(msoFileDialogFolderPicker) pour lui attribuer un chemin.
Ensuite utiliser des constantes pour accéder aux sous répertoires.

Const AFFICHES As String = "\Affiches\"
Const DRAPEAUX As String = "\Drapeaux\"
Const ACTEURS As String = "\Acteurs\"
Const ACTEURS2 As String = "\Acteurs\"

 

[AtTheOne]

Bonsoir @Valtrase,
C'est une possibilité sauf si le but est de faire une recherche sur toutes les unités du PC en une seule fois.
Sans plus d'informations que celles du post de départ difficile à dire.
À bientôt