Exclure l'affichage d'une seule affiche

Résolu/Fermé
dudulleray - Modifié par dudulleray le 28/01/2013 à 09:03
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 - 29 janv. 2013 à 09:16
Bonsoir a toutes et tous, Forum



J'ai dans ma colonne (A) une liste de noms de mes vidéos et dans la colonne (B) une liste de jaquettes correspondente a la vidéo.

EX:

A1= Tintin.avi B1=Tintin.jpg
A2=Bibi.avi B2=Bibi.jpg
etc etc

>>> Plus une jaquette (baptiser) Liberty.jpg qui se trouve dans la liste des autres jaquettes

je souhaiterai svp que le nom de "cette jaquette" n'apparaisse pas dans la liste des jaquettes de la colonne B

Ci-dessous deux petites macros pour gérer la récupération des noms des fichiers du disque E ou sont stockés mes vidéos et mes Jaquettes

Je vous remercie par avance de votre aide, de votre savoir ainsi que de votre temps.

bonne soirée a tous

Cordialement Ray

Sub RepertorierVideos() 
    Dim Chemin As String, Fichier As String, Numligne As Long 
     
Range("A:A") = "" 
     
    'indique le répertoire contenant les fichiers 
    Chemin = "E:\VIDEOS\" 
     
    'Boucle sur tous les fichiers .avi du répertoire 
    Fichier = Dir(Chemin & "*.avi") 

    Numligne = 1 
     
    Do While Len(Fichier) > 0 
        Sheets("Feuil1").Range("A" & Numligne).Value = Fichier 
        Numligne = Numligne + 1 
        Fichier = Dir() 
    Loop 
End Sub 

'--------------------------- 

Sub RepertorierAffiches() 
    Dim Chemin As String, Fichier As String, Numligne As Long 
    Range("B:B") = "" 
    'indique le répertoire contenant les fichiers 
    Chemin = "E:\AFFICHE\" 
     
    'Boucle sur tous les fichiers .jpg du répertoire 
    Fichier = Dir(Chemin & "*.jpg") 

    Numligne = 1 
     
    Do While Len(Fichier) > 0 
  
' *** Le test ci dessous n'ai pas bon, ca me laisse dans la liste colonne (B) une ligne vide        

If Fichier = "Liberty.jpg" Then Fichier = "" : Numligne = Numligne - 1 
       
        Sheets("Feuil1").Range("B" & Numligne).Value = Fichier 
        Numligne = Numligne + 1 
        Fichier = Dir() 
    Loop 
End Sub 

3 réponses

pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 751
Modifié par pijaku le 28/01/2013 à 09:25
Bonjour,

En fait, si Fichier = "Liberty.jpg" tu ne veux rien faire... Donc, ne fait rien :
Do While Len(Fichier) > 0  
   If Fichier = "Liberty.jpg" Then  
   Else    
      Sheets("Feuil1").Range("B" & Numligne).Value = Fichier  
      Numligne = Numligne + 1  
      Fichier = Dir() 
   End If  
Loop

Ou, plus élégant :
Do While Len(Fichier) > 0  
   If Fichier <> "Liberty.jpg" Then
      Sheets("Feuil1").Range("B" & Numligne).Value = Fichier  
      Numligne = Numligne + 1  
      Fichier = Dir() 
   End If  
Loop


Cordialement,
Franck P
1
Salut pijaku

Merci beaucoup pour ta réponse, j'ai essayer les deux codes que tu me propose et ca plante excel

le sablier se mets a tourner et ne s'arrete plus.

j'ignore pourquoi mais je suis obliger d'arreter excel et la plantage excel redemarre etc etc

a te relire avec plaisir

Cordialement Ray
0
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 751
28 janv. 2013 à 15:27
Salut,
Tu as intégré mon bout de code à ta macro ou juste copier-coller mon code dans une nouvelle procédure???
Parce qu'en fait, le code que je te donne ne diffère en rien (quasiment) de celui que tu nous donnais...
Je te remets ici le code complet modifié qu'il te faut utiliser :
Sub RepertorierAffiches() 
    Dim Chemin As String, Fichier As String, Numligne As Long 
    Range("B:B") = "" 
    'indique le répertoire contenant les fichiers 
    Chemin = "E:\AFFICHE\" 
    'Boucle sur tous les fichiers .jpg du répertoire 
    Fichier = Dir(Chemin & "*.jpg") 
    Numligne = 1 
Do While Len(Fichier) > 0  
   If Fichier <> "Liberty.jpg" Then
      Sheets("Feuil1").Range("B" & Numligne).Value = Fichier  
      Numligne = Numligne + 1  
      Fichier = Dir() 
   End If  
Loop
End Sub 
1
Re Salut pijaku

Bon je pense avoir trouver, j'ai dans le code End if juste en dessous Numligne

et la plus de plantage et ca fonctionne parfaitement

le code Fichier = Dir() ne plait visiblement pas a mon excel ou bien alors il y a une raison mais laquelle ???

j'ai bien tester et je confirme que ca marche bien

je te remercie beaucoup pour ton aide. le sujet pour moi est résolu

bonne soirée a toi

bien cordialement Raymond

Do While Len(Fichier) > 0  
   If Fichier <> "Liberty.jpg" Then
      Sheets("Feuil1").Range("B" & Numligne).Value = Fichier  
      Numligne = Numligne + 1  
    End if
      Fichier = Dir() 
  
Loop
End Sub 
0
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 751
29 janv. 2013 à 08:41
Salut,
Je suis surpris qu'en ayant oublié un "End If", le débogage ne se lance pas immédiatement...
Pour la ligne Fichier = Dir(), il n'y a aucune raison qu'Excel "n'aime" pas...
En tout cas, le principal est que cela fonctionne...
De rien et a+
0
Salut pijaku

Non je n'ai pas dit que tu avais oublier un End If ton code fonctionne bien

j'ai juste déplacer le End If je l'ai mis avant Fichier = Dir()

de cette facon chez moi ca fonctionne très bien et plus de plantage

voila je te remercie de nouveau pour ton aide

A plus tard sans doute je te souhaite une bonne journée malgré la pluie ici a Rouen

Cordialement Raymond
0
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 751
29 janv. 2013 à 09:16
excuse je n'avais pas saisi.
En effet, c'est une grossière erreur de ma part.
En fait, en mettant le End If après Fichier = Dir(), lorsque le nom de ton fichier est tombé sur liberty.jpg, comme on ne changeait plus le nom de fichier (Fichier = Dir() se trouvant à l'intérieur du test If), ma boucle tournait à l'infini avec effectivement plantage excel....... Sorry. Ca m'apprendra à mal tester les codes que je fournit.
Bonne journée à toi!
0