Private Sub horloge(md As String, f As String, D As String, R, CR) Dim x As Integer, k As Integer, fc As String x 0: k 0 If Dir(D, vbDirectory) = "" Then MkDir (D) fc = Dir(md & f, vbNormal Or vbHidden) Do While fc <> "" k = k + 1 Select Case k Case ((R(x) - CR(x)) \ 2) + 1 To ((R(x) - CR(x)) \ 2) + CR(x) FileCopy md & "" & fc, D & fc Case Is > R(x) - 1 k 0: x x + 1 If x > UBound(R) Then x = 0 End Select fc = Dir Loop End Sub
'les paramètres du dossier Dim mondossier As String, madesti As String, filtre As String, fic As String, rythme, corrythme filtre = "\*.*" '<<<<<============== ici : l'extension à filtrer mondossier = "D:\monoutil" ' <<<<<======================= ici ton dossier d'images à copier madesti = "D:\ahah" ' <<<<<<<<<<<<<=========== ici le dossier (éventuellement à créer) où envoyer tes trucs rythme = Array(13, 14) '<<<<<<======== ici tes cycles répétés corrythme = Array(3, 3) '<<<<<======== ici les conservés correspondant à chaque série ' appel de l'horloge horloge mondossier, filtre, madesti, rythme, corrythme
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre questiondossier = "D:\*.bmp" ' <<<===== ici : ton chemin et ton extension de fichier fic = Dir(dossier, vbNormal Or vbHidden) Do While fic <> "" compteur = compteur + 1 Select Case compteur Case 6 To 8, 21 To 23, 41 To 43, 51 To 53, 61 To 63, 71 To 73, 81 To 83, 91 To 93, 101 To 103, 111 To 113 MsgBox fic ' ======>> et là : ton filecopy au lieu de cette msgbox End Select fic = Dir Loop
dossier = "D:\*.bmp" ' <<<===== ici : ton chemin et ton extension de fichier fic = Dir(dossier, vbNormal Or vbHidden) Do While fic <> "" compteur = compteur + 1 Select Case compteur Case 6 To 8, 19 To 21, 32 To 34, 45 To 47, 58 To 60, 71 To 73, 84 To 86, 97 To 99, 110 To 112, 123 To 125 ' etc.... MsgBox fic ' ======>> et là : ton filecopy au lieu de cette msgbox End Select fic = Dir Loop
dossier = "D:\*.bmp" ' <<<===== ici : ton chemin et ton extension de fichier fic = Dir(dossier, vbNormal Or vbHidden) compteur = 5 Do While fic <> "" compteur = compteur + 1 If compteur 14 Then compteur 1 Select Case compteur Case 11 To 13 MsgBox fic ' ======>> et là : ton filecopy au lieu de cette msgbox End Select fic = Dir Loop
On ne sait pas dans quel ordre et si tes sélections de 13 peuvent ou non se "chevaucher".
J'en parle car s'il s'agit finalement de :
- sélectionner les 13 premières (disons de 1 à 13), de copier les 6,7 et 8 vers dossier DossierB
pui
- de prendre les 13 suivantes et kif kif etc ...
C'est encore plus simple et du l'as besoin alors d'aucune ListBox (suffit d'utiliser dir, de "sauter" les 5 premiers fichiers, de copier les 3 autres vers dossierB, de "sauter" les 10 suivants, de copier les 3 suivants, de "sauter" les 10 suivants, garder les 3 suivants, etc... jusqu'à ce qu'il n'y ait plus de combattants.
Dim mondossier As String, madesti As String, filtre As String, fic As String, compteur As Integer, nbserie As Integer Dim nblaisseravantapres As Integer filtre = "\*.*" '<<<<<============== ici : l'extension à filtrer mondossier = "D:" ' <<<<<======================= ici ton dossier d'images à copier madesti = "D:\ahah" ' <<<<<<<<<<<<<=========== ici le dossier (éventuellement à créer) où envoyer tes trucs nbserie = 13 nblaisseravantapres = 5 If Dir(madesti, vbDirectory) = "" Then MkDir (madesti) fic = Dir(mondossier & filtre, vbNormal Or vbHidden) compteur = nblaisseravantapres Do While fic <> "" compteur = compteur + 1 If compteur nbserie + 1 Then compteur 1 Select Case compteur Case 11 To 13 FileCopy mondossier & "" & fic, madesti & fic End Select fic = Dir Loop
Fichier = Dir(Dossier_Cible & Fichier_Extension, vbNormal Or vbHidden)
Option Explicit Sub EXTRACTION() Dim Dossier_Cible As String, Dossier_Destination As String, Fichier_Extension As String 'Déclaration des variables Dim Première_Série_Extraction As Long, Première_Série_Conservation As Long, Deuxième_Série_Extraction As Long, Deuxième_Série_Conservation Dim Compteur As Long Dim Fichier As Variant Dossier_Cible = Range("C3") 'Affectation des variables Dossier_Destination = Range("C4") Fichier_Extension = Range("C5") Première_Série_Extraction = Range("C6") Première_Série_Conservation = Range("C7") Deuxième_Série_Extraction = Range("C8") Deuxième_Série_Conservation = Range("C9") Fichier = Dir(Dossier_Cible & Fichier_Extension, vbNormal Or vbHidden) Compteur = 5 Do While Fichier <> "" Compteur = Compteur + 1 If Compteur 14 Then Compteur 1 Select Case Compteur Case 11 To 13 FileCopy Fichier ' ======>> et là : ton filecopy au lieu de cette msgbox End Select Fichier = Dir Loop End Sub
fichier = Dir(Dossier_Cible & "" & Fichier_Extension, vbNormal Or vbHidden)
fichier = Dir(Dossier_Cible & "\*" & Fichier_Extension, vbNormal Or vbHidden)
as-tu bien tous ces fichiers dans un seul et même dossier ?
tes "séries" sont-elles toujours d'un nombre égal ?
combien d'images x veux-tu garder par série : un chiffre ou un pourcentage
si j'ai bien compris, les x doivent être "au milieu" d'une série
- si x impair et que nb est pair ; comment choisis-tu les x
- si x est pair et que nb est impair : comment choisis-tu les x
a quoi distingues-tu exactement les photos d'une même série ?
L'extension est-elle toujours la même ? Si oui : laquelle ? si non : quelles sont-elles ?
les chiffres que montre ton fichier : à quoi correspondent-ils ? Pourquoi ici 14 et là 13 ? au pif ou en fonction d'une chose précise (et laquelle) ?
quel est le nombre maxi d'une série et quel est son nombre mini ?
et si maxi > que le chiffre retenu (13 ou 14) : que fais-tu ?
L'extension est-elle toujours la même ? Si oui : laquelle ? si non : quelles sont-elles ?