Aide pour me dépanner sur une procédure

MichDenis,

Merci pour ton aide.

Donc j'ai apporté tes dernières modifications, suite a ma demande.

J'ai du mal faire quelque chose ou je met pas les bon dossier dans les
variables :

1) Dans ce code :

Option Explicit
Private Declare Function SetCurrentDirectoryA Lib _
"kernel32" (ByVal lpPathName As String) As Long
Dim Tblo()
Dim A As Long
'---------------------------------------------
Public Sub ChDirNet(szPath As String)
Dim lReturn As Long
lReturn = SetCurrentDirectoryA(szPath)
If lReturn = 0 Then Err.Raise vbObjectError + 1, "Error setting path."
End Sub
'---------------------------------------------
Sub Liste_Des_Fichiers()
Dim X
Dim Répertoire As String

Répertoire = "c:UsersDMDocuments"
ChDirNet Répertoire
A = 0
Répertoire = ChoixDossierFichier & ""
If Répertoire <> "" Then
Call Contenu_Répertoire(Répertoire)
Call FoldersInFolder(Répertoire)
Call Traitement
End If

End Sub
'------------------------------------------

---> Je le met au tout début en remplacement de ce qu'il y avait déjà, et je
met quoi ici, je m'embrouille un peu.

Répertoire = "c:UsersDMDocuments"


2) Dans ce code
Répertoire = "c:denis"
If Dir(Répertoire, vbDirectory) = "" Then
MsgBox "Répertoire : " & Répertoire & _
" inexistant." & vbCrLf & "Opération annulée."
Exit Sub
End If

--> Je le met a quel niveau dans la procédure, car je pense que cela a son
importante.

Et Répertoire = "c:denis"

Dois-je le mettre a nouveau, ou cela correspond a autre chose?

Désolé mais je m'embrouille un pneu la.

Voici comment j'ai fait et a priori j'ai du mal faire, lol.



'Déclaration des variables dans le haut du module
Option Explicit
Private Declare Function SetCurrentDirectoryA Lib _
"kernel32" (ByVal lpPathName As String) As Long
Dim Tblo()
Dim A As Long
'---------------------------------------------
Public Sub ChDirNet(szPath As String)
Dim lReturn As Long
lReturn = SetCurrentDirectoryA(szPath)
If lReturn = 0 Then Err.Raise vbObjectError + 1, "Error setting path."
End Sub
'---------------------------------------------
Sub Liste_Des_Fichiers()
Dim X
Dim Répertoire As String

Répertoire = "O:Spectacle années en cours" 'Quelle destination ?
ChDirNet Répertoire
A = 0
Répertoire = ChoixDossierFichier & ""
If Répertoire <> "" Then
Call Contenu_Répertoire(Répertoire)
Call FoldersInFolder(Répertoire)
Call Traitement
End If
Répertoire = "O:Spectacle années en cours" 'Quelle destination ?

If Dir(Répertoire, vbDirectory) = "" Then
MsgBox "Répertoire : " & Répertoire & _
" inexistant." & vbCrLf & "Opération annulée."
Exit Sub
End If

End Sub
'------------------------------------------

'----------------------------------------
Sub FoldersInFolder(myFolderName As String)

Dim FSO As Object
Dim myBaseFolder As Object
Dim myFolder As Object

Set FSO = CreateObject("scripting.filesystemobject")
Set myBaseFolder = FSO.GetFolder(myFolderName)
For Each myFolder In myBaseFolder.SubFolders
Call Contenu_Répertoire(myFolder.Path & "")
Call FoldersInFolder(myFolder.Path)
Next myFolder

End Sub
'----------------------------------------
Sub Contenu_Répertoire(Chemin As String)
Dim Fichier As String
Fichier = Dir(Chemin & "*.mp3")
Do While Fichier <> ""
A = A + 1
ReDim Preserve Tblo(A)
Tblo(A) = Chemin & Fichier
Fichier = Dir()
Loop
End Sub
'----------------------------------------
Function ChoixDossierFichier$(Optional Racine)
Dim objShell, objFile, Chemin, SecuriteSlash, FlagChoix&, Msg$

If IsMissing(Racine) Then Racine = "O:Spectacle années en cours"
Msg = "Choisissez le fichier à ouvrir :"
Set objShell = CreateObject("Shell.Application")
Set objFile = objShell.BrowseForFolder(&H0&, Msg, &H4000, Racine)
On Error Resume Next
Chemin = objFile.ParentFolder.ParseName(objFile.Title).Path & ""
ChoixDossierFichier = Chemin
End Function
'----------------------------------------
Sub Traitement()
Dim Txt As String, i As Long, Fil As String
Dim Tablo1, Tablo2, Organisateurs As String
Dim Annee As String, A As String, B As String
Dim C As String, D As String, e As String, F As String
Dim G, f1, Ligne As Long, Choix ', fso, dossier

For i = 1 To UBound(Tblo)
Fil = Tblo(i)
Tablo1 = Split(Fil, "")
Tablo2 = Split(Tablo1(UBound(Tablo1)), "-")
If UBound(Tablo1) = 6 And _
UBound(Tablo2) = 3 And _
InStr(1, UCase(Fil), UCase(Txt)) > 0 Then
'Organisateurs
Organisateurs = Tablo1(2)
'Année
Annee = Tablo1(1)
Annee = Right(Annee, 4)
'A : N° de la partie -> (Donnée récupérée par rapport au dossier)
A = Tablo1(4)
A = Application.Substitute(A, "Partie ", "")
'B : N° du ballet -> (Donnée récupérée avec le nom du fichier)
B = Tablo2(0)
'C : Nom du prof -> (Données récupérées par rapport au dossier)
C = Tablo1(5)
'D : Groupe d 'élève -> (Données récupérées avec le nom du fichier)
D = Tablo2(1)
'E : Interprètes -> (Données récupérées avec le nom du fichier)
e = Tablo2(3)
e = Left(e, Len(e) - 4)
'F : Titres -> (Données récupérées avec le nom du fichier)
F = Tablo2(2)
'G : La durée de la chanson --> (Données récupérées avec le poids du fichier)
'(39934/176400)1024#2 sec soit 3'52 sec
G = FileLen(Fil)
G = G / 176400 / 60 / 60 / 24
'NUMEROTATION DES FICHIERS
With Sheets("Tool_Planning")
Application.ScreenUpdating = False
.Range("E6") = Organisateurs
Ligne = .Cells(.Cells.Rows.Count, 1).End(xlUp).Row + 1
.Cells(Ligne, "A") = A
.Cells(Ligne, "B") = B
.Cells(Ligne, "C") = C
.Cells(Ligne, "D") = D
.Cells(Ligne, "E") = e
.Cells(Ligne, "F") = F
.Cells(Ligne, "G") = G
.Cells(Ligne, "G").NumberFormat = "mm:ss"
If Range("A14").Value = 0 Then Exit Sub
Range("A14:G14").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Sort Key1:=Range("A14"), Order1:=xlAscending, _
Header:=xlNo, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom
Range("A14").Select
End With
End If
Next i
End Sub
'----------------------------------------


Merci encore, G'Claire


"G''Claire" a écrit :

Salut a toute et tous.

Je ne sais si vous allé pouvoire m'aider, mais je suis vraiment bien embété
et je n'arrive pas a me dépatouiller d'un truc qui fonctionné.

Cela fait prés de 5 Ans que j'utilise un fichier EXCEL pour générer des
feuilles, pour des spéctacles de danse ou autres, et la cela bloque sur la
procédure de vérification des fichiers audio dont le nom me sert a remplire
mes feuilles.

Donc voici comment je manipule cela .

1) J'ai un bouton qui lance la procédure "RecupDonneesBallets"

2) Cela m'ouvre une fenetre de sélection du dossier principale : Spectacle
années en cours.

3) La je sélectione le dossier de ma prestation (Chaque dossier de
prestation est constituer de la même manière):

Dans ce dossier il y a :

a) Tous les dosseir par professeurs avec leur musques dedans au format MP3
b) Un dossier "Musiques pour le gala" qui me sert pour la suite de la
procédure.

Et dans ce dossier il y a X parties de la prestation (Cela me sert a
remplire des informations dans les feuilles):

Partie 1
Partie 2
Partie 3


Et dans chaque partie il y a le nom de chaque professeurs de danse (Cela me
sert a remplire des informations dans les feuilles)

Et dans chaque dossiers il y a des fichier musiquaux, donc ces fichier me
sservent juste a extraire le nom du fichier pour remplire des informations
dans les feuilles)

J'espère que c'est claire.

Donc voici la procédure et cela bloque à : With Application.FileSearch.

Et comme erreur j'ai :

Erreur d'éxécution '445'
Cet objet ne gère pas action.



Sub RecupDonneesBallets()
Dim txt As String, i As Long, fil As String
Dim tablo1, tablo2, Organisateurs As String
Dim Annee As String, a As String, b As String, c As String, d As String, e
As String, f As String
Dim g, f1, ligne As Long, choix ', fso, dossier
With Sheets("Tool_Planning")
Application.ScreenUpdating = False
Range("A14:G14").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Range("A14").Select
End With
txt = "Musiques pour le gala"
choix = ChoixDossierFichier("O:Spectacle années en cours")
If choix <> "" Then
With Application.FileSearch
.LookIn = choix
.Filename = "*.MP3"
.SearchSubFolders = True
If .Execute > 0 Then
For i = 1 To .FoundFiles.Count
fil = .FoundFiles(i)
tablo1 = Split(fil, "")
tablo2 = Split(tablo1(UBound(tablo1)), "-")
If UBound(tablo1) = 6 And _
UBound(tablo2) = 3 And _
InStr(1, UCase(fil), UCase(txt)) > 0 Then
'Organisateurs
Organisateurs = tablo1(2)
'Année
Annee = tablo1(1)
Annee = Right(Annee, 4)
'A : N° de la partie -> (Donnée récupérée par rapport au dossier)
a = tablo1(4)
a = Application.Substitute(a, "Partie ", "")
'B : N° du ballet -> (Donnée récupérée avec le nom du fichier)
b = tablo2(0)
'C : Nom du prof -> (Données récupérées par rapport au dossier)
c = tablo1(5)
'D : Groupe d 'élève -> (Données récupérées avec le nom du fichier)
d = tablo2(1)
'E : Interprètes -> (Données récupérées avec le nom du fichier)
e = tablo2(3)
e = Left(e, Len(e) - 4)
'F : Titres -> (Données récupérées avec le nom du fichier)
f = tablo2(2)
'G : La durée de la chanson --> (Données récupérées avec le poids du fichier)
'(39934/176400)1024#2 sec soit 3'52 sec
g = FileLen(fil)
g = g / 176400 / 60 / 60 / 24
'NUMEROTATION DES FICHIERS
With Sheets("Tool_Planning")
Application.ScreenUpdating = False
.Range("E6") = Organisateurs
ligne = .Cells(.Cells.Rows.Count, 1).End(xlUp).Row + 1
.Cells(ligne, "A") = a
.Cells(ligne, "B") = b
.Cells(ligne, "C") = c
.Cells(ligne, "D") = d
.Cells(ligne, "E") = e
.Cells(ligne, "F") = f
.Cells(ligne, "G") = g
.Cells(ligne, "G").NumberFormat = "mm:ss"
If Range("A14").Value = 0 Then Exit Sub

Range("A14:G14").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Sort Key1:=Range("A14"), Order1:=xlAscending, _
Header:=xlNo, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom
Range("A14").Select
End With
End If
Next i
End If
End With
End If
Application.ScreenUpdating = True
Call creer_feuille

End Sub

J'espère vraiment être assez claire afin que vous puissiez me dépanner, car
la je nage complètement.

Cette procédure je ne l'ai pas écrite et je ne me rappel plus qui me la
faite, c'est un fichier ou beaucoup d'internaute m'ont aidé.

Si besoin est je peux fournire le fichier complet, il n'y a rien de
confidentiel.

Sincères salutations, G'Claire

C'était un répertoire de mon environnement de travail:

| Répertoire = "c:UsersDMDocuments"

Répertoire est une variable qui doit contenir le répertoire
source de TON choix de TON environnement de travail où
tu voudrais donner un choix de sélection à l'usager.


"G''Claire" <jacouille@discution.microsoft.com> a écrit dans le message de groupe de
discussion : 761A1BB3-8870-4990-B42D-FFE1DC9C3EC7@microsoft.com...
MichDenis,

Merci pour ton aide.

Donc j'ai apporté tes dernières modifications, suite a ma demande.

J'ai du mal faire quelque chose ou je met pas les bon dossier dans les
variables :

1) Dans ce code :

Option Explicit
Private Declare Function SetCurrentDirectoryA Lib _
"kernel32" (ByVal lpPathName As String) As Long
Dim Tblo()
Dim A As Long
'---------------------------------------------
Public Sub ChDirNet(szPath As String)
Dim lReturn As Long
lReturn = SetCurrentDirectoryA(szPath)
If lReturn = 0 Then Err.Raise vbObjectError + 1, "Error setting path."
End Sub
'---------------------------------------------
Sub Liste_Des_Fichiers()
Dim X
Dim Répertoire As String

Répertoire = "c:UsersDMDocuments"
ChDirNet Répertoire
A = 0
Répertoire = ChoixDossierFichier & ""
If Répertoire <> "" Then
Call Contenu_Répertoire(Répertoire)
Call FoldersInFolder(Répertoire)
Call Traitement
End If

End Sub
'------------------------------------------

---> Je le met au tout début en remplacement de ce qu'il y avait déjà, et je
met quoi ici, je m'embrouille un peu.

Répertoire = "c:UsersDMDocuments"


2) Dans ce code
Répertoire = "c:denis"
If Dir(Répertoire, vbDirectory) = "" Then
MsgBox "Répertoire : " & Répertoire & _
" inexistant." & vbCrLf & "Opération annulée."
Exit Sub
End If

--> Je le met a quel niveau dans la procédure, car je pense que cela a son
importante.

Et Répertoire = "c:denis"

Dois-je le mettre a nouveau, ou cela correspond a autre chose?

Désolé mais je m'embrouille un pneu la.

Voici comment j'ai fait et a priori j'ai du mal faire, lol.



'Déclaration des variables dans le haut du module
Option Explicit
Private Declare Function SetCurrentDirectoryA Lib _
"kernel32" (ByVal lpPathName As String) As Long
Dim Tblo()
Dim A As Long
'---------------------------------------------
Public Sub ChDirNet(szPath As String)
Dim lReturn As Long
lReturn = SetCurrentDirectoryA(szPath)
If lReturn = 0 Then Err.Raise vbObjectError + 1, "Error setting path."
End Sub
'---------------------------------------------
Sub Liste_Des_Fichiers()
Dim X
Dim Répertoire As String

Répertoire = "O:Spectacle années en cours" 'Quelle destination ?
ChDirNet Répertoire
A = 0
Répertoire = ChoixDossierFichier & ""
If Répertoire <> "" Then
Call Contenu_Répertoire(Répertoire)
Call FoldersInFolder(Répertoire)
Call Traitement
End If
Répertoire = "O:Spectacle années en cours" 'Quelle destination ?

If Dir(Répertoire, vbDirectory) = "" Then
MsgBox "Répertoire : " & Répertoire & _
" inexistant." & vbCrLf & "Opération annulée."
Exit Sub
End If

End Sub
'------------------------------------------

'----------------------------------------
Sub FoldersInFolder(myFolderName As String)

Dim FSO As Object
Dim myBaseFolder As Object
Dim myFolder As Object

Set FSO = CreateObject("scripting.filesystemobject")
Set myBaseFolder = FSO.GetFolder(myFolderName)
For Each myFolder In myBaseFolder.SubFolders
Call Contenu_Répertoire(myFolder.Path & "")
Call FoldersInFolder(myFolder.Path)
Next myFolder

End Sub
'----------------------------------------
Sub Contenu_Répertoire(Chemin As String)
Dim Fichier As String
Fichier = Dir(Chemin & "*.mp3")
Do While Fichier <> ""
A = A + 1
ReDim Preserve Tblo(A)
Tblo(A) = Chemin & Fichier
Fichier = Dir()
Loop
End Sub
'----------------------------------------
Function ChoixDossierFichier$(Optional Racine)
Dim objShell, objFile, Chemin, SecuriteSlash, FlagChoix&, Msg$

If IsMissing(Racine) Then Racine = "O:Spectacle années en cours"
Msg = "Choisissez le fichier à ouvrir :"
Set objShell = CreateObject("Shell.Application")
Set objFile = objShell.BrowseForFolder(&H0&, Msg, &H4000, Racine)
On Error Resume Next
Chemin = objFile.ParentFolder.ParseName(objFile.Title).Path & ""
ChoixDossierFichier = Chemin
End Function
'----------------------------------------
Sub Traitement()
Dim Txt As String, i As Long, Fil As String
Dim Tablo1, Tablo2, Organisateurs As String
Dim Annee As String, A As String, B As String
Dim C As String, D As String, e As String, F As String
Dim G, f1, Ligne As Long, Choix ', fso, dossier

For i = 1 To UBound(Tblo)
Fil = Tblo(i)
Tablo1 = Split(Fil, "")
Tablo2 = Split(Tablo1(UBound(Tablo1)), "-")
If UBound(Tablo1) = 6 And _
UBound(Tablo2) = 3 And _
InStr(1, UCase(Fil), UCase(Txt)) > 0 Then
'Organisateurs
Organisateurs = Tablo1(2)
'Année
Annee = Tablo1(1)
Annee = Right(Annee, 4)
'A : N° de la partie -> (Donnée récupérée par rapport au dossier)
A = Tablo1(4)
A = Application.Substitute(A, "Partie ", "")
'B : N° du ballet -> (Donnée récupérée avec le nom du fichier)
B = Tablo2(0)
'C : Nom du prof -> (Données récupérées par rapport au dossier)
C = Tablo1(5)
'D : Groupe d 'élève -> (Données récupérées avec le nom du fichier)
D = Tablo2(1)
'E : Interprètes -> (Données récupérées avec le nom du fichier)
e = Tablo2(3)
e = Left(e, Len(e) - 4)
'F : Titres -> (Données récupérées avec le nom du fichier)
F = Tablo2(2)
'G : La durée de la chanson --> (Données récupérées avec le poids du fichier)
'(39934/176400)1024#2 sec soit 3'52 sec
G = FileLen(Fil)
G = G / 176400 / 60 / 60 / 24
'NUMEROTATION DES FICHIERS
With Sheets("Tool_Planning")
Application.ScreenUpdating = False
.Range("E6") = Organisateurs
Ligne = .Cells(.Cells.Rows.Count, 1).End(xlUp).Row + 1
.Cells(Ligne, "A") = A
.Cells(Ligne, "B") = B
.Cells(Ligne, "C") = C
.Cells(Ligne, "D") = D
.Cells(Ligne, "E") = e
.Cells(Ligne, "F") = F
.Cells(Ligne, "G") = G
.Cells(Ligne, "G").NumberFormat = "mm:ss"
If Range("A14").Value = 0 Then Exit Sub
Range("A14:G14").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Sort Key1:=Range("A14"), Order1:=xlAscending, _
Header:=xlNo, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom
Range("A14").Select
End With
End If
Next i
End Sub
'----------------------------------------


Merci encore, G'Claire


"G''Claire" a écrit :

Salut a toute et tous.

Je ne sais si vous allé pouvoire m'aider, mais je suis vraiment bien embété
et je n'arrive pas a me dépatouiller d'un truc qui fonctionné.

Cela fait prés de 5 Ans que j'utilise un fichier EXCEL pour générer des
feuilles, pour des spéctacles de danse ou autres, et la cela bloque sur la
procédure de vérification des fichiers audio dont le nom me sert a remplire
mes feuilles.

Donc voici comment je manipule cela .

1) J'ai un bouton qui lance la procédure "RecupDonneesBallets"

2) Cela m'ouvre une fenetre de sélection du dossier principale : Spectacle
années en cours.

3) La je sélectione le dossier de ma prestation (Chaque dossier de
prestation est constituer de la même manière):

Dans ce dossier il y a :

a) Tous les dosseir par professeurs avec leur musques dedans au format MP3
b) Un dossier "Musiques pour le gala" qui me sert pour la suite de la
procédure.

Et dans ce dossier il y a X parties de la prestation (Cela me sert a
remplire des informations dans les feuilles):

Partie 1
Partie 2
Partie 3


Et dans chaque partie il y a le nom de chaque professeurs de danse (Cela me
sert a remplire des informations dans les feuilles)

Et dans chaque dossiers il y a des fichier musiquaux, donc ces fichier me
sservent juste a extraire le nom du fichier pour remplire des informations
dans les feuilles)

J'espère que c'est claire.

Donc voici la procédure et cela bloque à : With Application.FileSearch.

Et comme erreur j'ai :

Erreur d'éxécution '445'
Cet objet ne gère pas action.



Sub RecupDonneesBallets()
Dim txt As String, i As Long, fil As String
Dim tablo1, tablo2, Organisateurs As String
Dim Annee As String, a As String, b As String, c As String, d As String, e
As String, f As String
Dim g, f1, ligne As Long, choix ', fso, dossier
With Sheets("Tool_Planning")
Application.ScreenUpdating = False
Range("A14:G14").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Range("A14").Select
End With
txt = "Musiques pour le gala"
choix = ChoixDossierFichier("O:Spectacle années en cours")
If choix <> "" Then
With Application.FileSearch
.LookIn = choix
.Filename = "*.MP3"
.SearchSubFolders = True
If .Execute > 0 Then
For i = 1 To .FoundFiles.Count
fil = .FoundFiles(i)
tablo1 = Split(fil, "")
tablo2 = Split(tablo1(UBound(tablo1)), "-")
If UBound(tablo1) = 6 And _
UBound(tablo2) = 3 And _
InStr(1, UCase(fil), UCase(txt)) > 0 Then
'Organisateurs
Organisateurs = tablo1(2)
'Année
Annee = tablo1(1)
Annee = Right(Annee, 4)
'A : N° de la partie -> (Donnée récupérée par rapport au dossier)
a = tablo1(4)
a = Application.Substitute(a, "Partie ", "")
'B : N° du ballet -> (Donnée récupérée avec le nom du fichier)
b = tablo2(0)
'C : Nom du prof -> (Données récupérées par rapport au dossier)
c = tablo1(5)
'D : Groupe d 'élève -> (Données récupérées avec le nom du fichier)
d = tablo2(1)
'E : Interprètes -> (Données récupérées avec le nom du fichier)
e = tablo2(3)
e = Left(e, Len(e) - 4)
'F : Titres -> (Données récupérées avec le nom du fichier)
f = tablo2(2)
'G : La durée de la chanson --> (Données récupérées avec le poids du fichier)
'(39934/176400)1024#2 sec soit 3'52 sec
g = FileLen(fil)
g = g / 176400 / 60 / 60 / 24
'NUMEROTATION DES FICHIERS
With Sheets("Tool_Planning")
Application.ScreenUpdating = False
.Range("E6") = Organisateurs
ligne = .Cells(.Cells.Rows.Count, 1).End(xlUp).Row + 1
.Cells(ligne, "A") = a
.Cells(ligne, "B") = b
.Cells(ligne, "C") = c
.Cells(ligne, "D") = d
.Cells(ligne, "E") = e
.Cells(ligne, "F") = f
.Cells(ligne, "G") = g
.Cells(ligne, "G").NumberFormat = "mm:ss"
If Range("A14").Value = 0 Then Exit Sub

Range("A14:G14").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Sort Key1:=Range("A14"), Order1:=xlAscending, _
Header:=xlNo, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom
Range("A14").Select
End With
End If
Next i
End If
End With
End If
Application.ScreenUpdating = True
Call creer_feuille

End Sub

J'espère vraiment être assez claire afin que vous puissiez me dépanner, car
la je nage complètement.

Cette procédure je ne l'ai pas écrite et je ne me rappel plus qui me la
faite, c'est un fichier ou beaucoup d'internaute m'ont aidé.

Si besoin est je peux fournire le fichier complet, il n'y a rien de
confidentiel.

Sincères salutations, G'Claire

Le groupe de discution , MichDenis,

Donc, j'ai encore regardé cette nuité ce code.

Pour ce qui est de mon probleme de temps, j'ai retrouvé, a la base ce
fichier était plus prévue pour des musiques en .wav, et la formule de calcule
était cela :

'G : La durée de la chanson --> (Données récupérées avec le poids du fichier)
'(39934/176400)1024#2 sec soit 3'52 sec
G = FileLen(Fil)
G = G / 176400 / 60 / 60 / 24

Mais de plus en plus on me donne des MP3, donc cela correspond a plus rien.

Serait il possible de faire un truc qui, suivant l'extension me calcul le
temps de la zik, pour le MP je crois qu'il a le tag du fichier qui pourrai
peut être faire l'affaire, a voir je suis spécialiste.

Voici un code que j'utilise de temps en temps pour lister des fichier d'un
répertoire et remplire les célulles suivant des tag, je l'avais récupéré sur
le net.

Option Explicit

Sub MP3_Listing()
Dim sPath As String: sPath = GetShellFolder
If sPath = "" Then Exit Sub
If Dir(sPath, vbDirectory) = "" Then Exit Sub
Dim Headers(35), x%, y&, i&, p$, n$, oFile As Object
Dim objShell As Object, oFolder As Object
Set objShell = CreateObject("Shell.Application")
Set oFolder = objShell.Namespace(CStr(sPath))
Application.ScreenUpdating = False
'Workbooks.Add
For i = 0 To 34
Headers(i) = oFolder.GetDetailsOf(oFolder.Items, i)
Select Case i
Case 22, 18, 20, 33, 17, 4, 0, 9, 19, 10, 21 '0 To 50, si on veux tout lister
x = x + 1
Cells(1, x) = Headers(i)
End Select
Next
y = 1
For Each oFile In oFolder.Items
p = oFile.Path: n = oFile.Name
x = 0: y = y + 1
For i = 0 To 34
Select Case i
Case 22, 18, 20, 33, 17, 4, 0, 9, 19, 10, 21 ' 0 To 50, si
on veux tout lister
x = x + 1
Cells(y, x) = oFolder.GetDetailsOf(oFile, i)
With ActiveSheet
.Hyperlinks.Add .Range("A" & y), Hlink(p), , n, n
End With
End Select
Next
Next
Range("A2").Select
ActiveWindow.FreezePanes = True
Rows("1:1").Font.Bold = True
Cells.Columns.AutoFit
Range("A1").Select
Set oFolder = Nothing: Set objShell = Nothing
End Sub
'-----------------------------------------
Private Function GetShellFolder() As String
Const Title = "Sélectionnez un répertoire !"
Dim oSHA As Object, oSF As Object, oItem As Object
On Error GoTo 1
Set oSHA = CreateObject("Shell.Application")
Set oSF = oSHA.BrowseForFolder(0, Title, &H1 Or &H10, &H11)
If InStr(TypeName(oSF), "Folder") <> 1 Then Exit Function
For Each oItem In oSF.parentfolder.Items
If oItem.Name = oSF.Title Then
GetShellFolder = oItem.Path
Exit Function
End If
Next
GetShellFolder = oSF.Title
Set oSF = Nothing: Set oSHA = Nothing
Exit Function
1: MsgBox "Error: " & Err.Number & vbLf & Err.Description, 48
End Function
'-----------------------------------------
Private Function Hlink(p As String) As String
Hlink = "file:///" & Replace(Replace(p, " ", "%20"), "", "/")
End Function

A moins qu'il éxiste un moyen de faire cette récupération du temps du
morceau valable pour tous les type de fichier audio, je ne sais pas.

Pour ce qui est du code que tu m'avait donné, je t'avoue avoir un peu de
mal, car je ne sais pas si je met les bonnes direction pour les dossiers.

Je revoi cela ce matin et te remet le code tel que je pense qu'il doit être
mis.

Si tu as du temps pour regarder cela se serait vraiment cool de ta part.

Merci par avance, G'Claire

"G''Claire" a écrit :

MichDenis,

Merci pour ton aide.

Donc j'ai apporté tes dernières modifications, suite a ma demande.

J'ai du mal faire quelque chose ou je met pas les bon dossier dans les
variables :

1) Dans ce code :

Option Explicit
Private Declare Function SetCurrentDirectoryA Lib _
"kernel32" (ByVal lpPathName As String) As Long
Dim Tblo()
Dim A As Long
'---------------------------------------------
Public Sub ChDirNet(szPath As String)
Dim lReturn As Long
lReturn = SetCurrentDirectoryA(szPath)
If lReturn = 0 Then Err.Raise vbObjectError + 1, "Error setting path."
End Sub
'---------------------------------------------
Sub Liste_Des_Fichiers()
Dim X
Dim Répertoire As String

Répertoire = "c:UsersDMDocuments"
ChDirNet Répertoire
A = 0
Répertoire = ChoixDossierFichier & ""
If Répertoire <> "" Then
Call Contenu_Répertoire(Répertoire)
Call FoldersInFolder(Répertoire)
Call Traitement
End If

End Sub
'------------------------------------------

---> Je le met au tout début en remplacement de ce qu'il y avait déjà, et je
met quoi ici, je m'embrouille un peu.

Répertoire = "c:UsersDMDocuments"


2) Dans ce code
Répertoire = "c:denis"
If Dir(Répertoire, vbDirectory) = "" Then
MsgBox "Répertoire : " & Répertoire & _
" inexistant." & vbCrLf & "Opération annulée."
Exit Sub
End If

--> Je le met a quel niveau dans la procédure, car je pense que cela a son
importante.

Et Répertoire = "c:denis"

Dois-je le mettre a nouveau, ou cela correspond a autre chose?

Désolé mais je m'embrouille un pneu la.

Voici comment j'ai fait et a priori j'ai du mal faire, lol.



'Déclaration des variables dans le haut du module
Option Explicit
Private Declare Function SetCurrentDirectoryA Lib _
"kernel32" (ByVal lpPathName As String) As Long
Dim Tblo()
Dim A As Long
'---------------------------------------------
Public Sub ChDirNet(szPath As String)
Dim lReturn As Long
lReturn = SetCurrentDirectoryA(szPath)
If lReturn = 0 Then Err.Raise vbObjectError + 1, "Error setting path."
End Sub
'---------------------------------------------
Sub Liste_Des_Fichiers()
Dim X
Dim Répertoire As String

Répertoire = "O:Spectacle années en cours" 'Quelle destination ?
ChDirNet Répertoire
A = 0
Répertoire = ChoixDossierFichier & ""
If Répertoire <> "" Then
Call Contenu_Répertoire(Répertoire)
Call FoldersInFolder(Répertoire)
Call Traitement
End If
Répertoire = "O:Spectacle années en cours" 'Quelle destination ?

If Dir(Répertoire, vbDirectory) = "" Then
MsgBox "Répertoire : " & Répertoire & _
" inexistant." & vbCrLf & "Opération annulée."
Exit Sub
End If

End Sub
'------------------------------------------

'----------------------------------------
Sub FoldersInFolder(myFolderName As String)

Dim FSO As Object
Dim myBaseFolder As Object
Dim myFolder As Object

Set FSO = CreateObject("scripting.filesystemobject")
Set myBaseFolder = FSO.GetFolder(myFolderName)
For Each myFolder In myBaseFolder.SubFolders
Call Contenu_Répertoire(myFolder.Path & "")
Call FoldersInFolder(myFolder.Path)
Next myFolder

End Sub
'----------------------------------------
Sub Contenu_Répertoire(Chemin As String)
Dim Fichier As String
Fichier = Dir(Chemin & "*.mp3")
Do While Fichier <> ""
A = A + 1
ReDim Preserve Tblo(A)
Tblo(A) = Chemin & Fichier
Fichier = Dir()
Loop
End Sub
'----------------------------------------
Function ChoixDossierFichier$(Optional Racine)
Dim objShell, objFile, Chemin, SecuriteSlash, FlagChoix&, Msg$

If IsMissing(Racine) Then Racine = "O:Spectacle années en cours"
Msg = "Choisissez le fichier à ouvrir :"
Set objShell = CreateObject("Shell.Application")
Set objFile = objShell.BrowseForFolder(&H0&, Msg, &H4000, Racine)
On Error Resume Next
Chemin = objFile.ParentFolder.ParseName(objFile.Title).Path & ""
ChoixDossierFichier = Chemin
End Function
'----------------------------------------
Sub Traitement()
Dim Txt As String, i As Long, Fil As String
Dim Tablo1, Tablo2, Organisateurs As String
Dim Annee As String, A As String, B As String
Dim C As String, D As String, e As String, F As String
Dim G, f1, Ligne As Long, Choix ', fso, dossier

For i = 1 To UBound(Tblo)
Fil = Tblo(i)
Tablo1 = Split(Fil, "")
Tablo2 = Split(Tablo1(UBound(Tablo1)), "-")
If UBound(Tablo1) = 6 And _
UBound(Tablo2) = 3 And _
InStr(1, UCase(Fil), UCase(Txt)) > 0 Then
'Organisateurs
Organisateurs = Tablo1(2)
'Année
Annee = Tablo1(1)
Annee = Right(Annee, 4)
'A : N° de la partie -> (Donnée récupérée par rapport au dossier)
A = Tablo1(4)
A = Application.Substitute(A, "Partie ", "")
'B : N° du ballet -> (Donnée récupérée avec le nom du fichier)
B = Tablo2(0)
'C : Nom du prof -> (Données récupérées par rapport au dossier)
C = Tablo1(5)
'D : Groupe d 'élève -> (Données récupérées avec le nom du fichier)
D = Tablo2(1)
'E : Interprètes -> (Données récupérées avec le nom du fichier)
e = Tablo2(3)
e = Left(e, Len(e) - 4)
'F : Titres -> (Données récupérées avec le nom du fichier)
F = Tablo2(2)
'G : La durée de la chanson --> (Données récupérées avec le poids du fichier)
'(39934/176400)1024#2 sec soit 3'52 sec
G = FileLen(Fil)
G = G / 176400 / 60 / 60 / 24
'NUMEROTATION DES FICHIERS
With Sheets("Tool_Planning")
Application.ScreenUpdating = False
.Range("E6") = Organisateurs
Ligne = .Cells(.Cells.Rows.Count, 1).End(xlUp).Row + 1
.Cells(Ligne, "A") = A
.Cells(Ligne, "B") = B
.Cells(Ligne, "C") = C
.Cells(Ligne, "D") = D
.Cells(Ligne, "E") = e
.Cells(Ligne, "F") = F
.Cells(Ligne, "G") = G
.Cells(Ligne, "G").NumberFormat = "mm:ss"
If Range("A14").Value = 0 Then Exit Sub
Range("A14:G14").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Sort Key1:=Range("A14"), Order1:=xlAscending, _
Header:=xlNo, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom
Range("A14").Select
End With
End If
Next i
End Sub
'----------------------------------------


Merci encore, G'Claire


"G''Claire" a écrit :

> Salut a toute et tous.
>
> Je ne sais si vous allé pouvoire m'aider, mais je suis vraiment bien embété
> et je n'arrive pas a me dépatouiller d'un truc qui fonctionné.
>
> Cela fait prés de 5 Ans que j'utilise un fichier EXCEL pour générer des
> feuilles, pour des spéctacles de danse ou autres, et la cela bloque sur la
> procédure de vérification des fichiers audio dont le nom me sert a remplire
> mes feuilles.
>
> Donc voici comment je manipule cela .
>
> 1) J'ai un bouton qui lance la procédure "RecupDonneesBallets"
>
> 2) Cela m'ouvre une fenetre de sélection du dossier principale : Spectacle
> années en cours.
>
> 3) La je sélectione le dossier de ma prestation (Chaque dossier de
> prestation est constituer de la même manière):
>
> Dans ce dossier il y a :
>
> a) Tous les dosseir par professeurs avec leur musques dedans au format MP3
> b) Un dossier "Musiques pour le gala" qui me sert pour la suite de la
> procédure.
>
> Et dans ce dossier il y a X parties de la prestation (Cela me sert a
> remplire des informations dans les feuilles):
>
> Partie 1
> Partie 2
> Partie 3
>
>
> Et dans chaque partie il y a le nom de chaque professeurs de danse (Cela me
> sert a remplire des informations dans les feuilles)
>
> Et dans chaque dossiers il y a des fichier musiquaux, donc ces fichier me
> sservent juste a extraire le nom du fichier pour remplire des informations
> dans les feuilles)
>
> J'espère que c'est claire.
>
> Donc voici la procédure et cela bloque à : With Application.FileSearch.
>
> Et comme erreur j'ai :
>
> Erreur d'éxécution '445'
> Cet objet ne gère pas action.
>
>
>
> Sub RecupDonneesBallets()
> Dim txt As String, i As Long, fil As String
> Dim tablo1, tablo2, Organisateurs As String
> Dim Annee As String, a As String, b As String, c As String, d As String, e
> As String, f As String
> Dim g, f1, ligne As Long, choix ', fso, dossier
> With Sheets("Tool_Planning")
> Application.ScreenUpdating = False
> Range("A14:G14").Select
> Range(Selection, Selection.End(xlDown)).Select
> Selection.ClearContents
> Range("A14").Select
> End With
> txt = "Musiques pour le gala"
> choix = ChoixDossierFichier("O:Spectacle années en cours")
> If choix <> "" Then
> With Application.FileSearch
> .LookIn = choix
> .Filename = "*.MP3"
> .SearchSubFolders = True
> If .Execute > 0 Then
> For i = 1 To .FoundFiles.Count
> fil = .FoundFiles(i)
> tablo1 = Split(fil, "")
> tablo2 = Split(tablo1(UBound(tablo1)), "-")
> If UBound(tablo1) = 6 And _
> UBound(tablo2) = 3 And _
> InStr(1, UCase(fil), UCase(txt)) > 0 Then
> 'Organisateurs
> Organisateurs = tablo1(2)
> 'Année
> Annee = tablo1(1)
> Annee = Right(Annee, 4)
> 'A : N° de la partie -> (Donnée récupérée par rapport au dossier)
> a = tablo1(4)
> a = Application.Substitute(a, "Partie ", "")

Pour faire la gestion des "tags" des fichiers MP3, il y a
des gratuiciels sur le web pour faire ce type de boulot.
Celui-ci que tu peux télécharger à cette adresse :
http://www.clubic.com/telecharger-fiche12753-mp3tag.html

Il y a aussi le logiciel Foobar2000 téléchargeable gratuitement à partir
du Web qui permet d'éditer les "Tags" en plus de convertir des plages
de musiques d'un format à un autre. Exemple : fichier Wav en MP3
Très performant... et en plus le code est ouvert !

Sur le site de Misange, Excelabo.Net , fais une recherche, je crois que
tu trouveras des exemples voire des fichiers Excel tout prêt.

Si rien de ce qui précède ne correspond à ton besoin, il faudra définir précisément
ce que tu recherches à faire avec l'aide d'Excel




"G''Claire" <jacouille@discution.microsoft.com> a écrit dans le message de groupe de
discussion : 98E0B2E0-4BE1-4BB5-A87E-B29F86EBF598@microsoft.com...
Le groupe de discution , MichDenis,

Donc, j'ai encore regardé cette nuité ce code.

Pour ce qui est de mon probleme de temps, j'ai retrouvé, a la base ce
fichier était plus prévue pour des musiques en .wav, et la formule de calcule
était cela :

'G : La durée de la chanson --> (Données récupérées avec le poids du fichier)
'(39934/176400)1024#2 sec soit 3'52 sec
G = FileLen(Fil)
G = G / 176400 / 60 / 60 / 24

Mais de plus en plus on me donne des MP3, donc cela correspond a plus rien.

Serait il possible de faire un truc qui, suivant l'extension me calcul le
temps de la zik, pour le MP je crois qu'il a le tag du fichier qui pourrai
peut être faire l'affaire, a voir je suis spécialiste.

Voici un code que j'utilise de temps en temps pour lister des fichier d'un
répertoire et remplire les célulles suivant des tag, je l'avais récupéré sur
le net.

Option Explicit

Sub MP3_Listing()
Dim sPath As String: sPath = GetShellFolder
If sPath = "" Then Exit Sub
If Dir(sPath, vbDirectory) = "" Then Exit Sub
Dim Headers(35), x%, y&, i&, p$, n$, oFile As Object
Dim objShell As Object, oFolder As Object
Set objShell = CreateObject("Shell.Application")
Set oFolder = objShell.Namespace(CStr(sPath))
Application.ScreenUpdating = False
'Workbooks.Add
For i = 0 To 34
Headers(i) = oFolder.GetDetailsOf(oFolder.Items, i)
Select Case i
Case 22, 18, 20, 33, 17, 4, 0, 9, 19, 10, 21 '0 To 50, si on veux tout lister
x = x + 1
Cells(1, x) = Headers(i)
End Select
Next
y = 1
For Each oFile In oFolder.Items
p = oFile.Path: n = oFile.Name
x = 0: y = y + 1
For i = 0 To 34
Select Case i
Case 22, 18, 20, 33, 17, 4, 0, 9, 19, 10, 21 ' 0 To 50, si
on veux tout lister
x = x + 1
Cells(y, x) = oFolder.GetDetailsOf(oFile, i)
With ActiveSheet
.Hyperlinks.Add .Range("A" & y), Hlink(p), , n, n
End With
End Select
Next
Next
Range("A2").Select
ActiveWindow.FreezePanes = True
Rows("1:1").Font.Bold = True
Cells.Columns.AutoFit
Range("A1").Select
Set oFolder = Nothing: Set objShell = Nothing
End Sub
'-----------------------------------------
Private Function GetShellFolder() As String
Const Title = "Sélectionnez un répertoire !"
Dim oSHA As Object, oSF As Object, oItem As Object
On Error GoTo 1
Set oSHA = CreateObject("Shell.Application")
Set oSF = oSHA.BrowseForFolder(0, Title, &H1 Or &H10, &H11)
If InStr(TypeName(oSF), "Folder") <> 1 Then Exit Function
For Each oItem In oSF.parentfolder.Items
If oItem.Name = oSF.Title Then
GetShellFolder = oItem.Path
Exit Function
End If
Next
GetShellFolder = oSF.Title
Set oSF = Nothing: Set oSHA = Nothing
Exit Function
1: MsgBox "Error: " & Err.Number & vbLf & Err.Description, 48
End Function
'-----------------------------------------
Private Function Hlink(p As String) As String
Hlink = "file:///" & Replace(Replace(p, " ", "%20"), "", "/")
End Function

A moins qu'il éxiste un moyen de faire cette récupération du temps du
morceau valable pour tous les type de fichier audio, je ne sais pas.

Pour ce qui est du code que tu m'avait donné, je t'avoue avoir un peu de
mal, car je ne sais pas si je met les bonnes direction pour les dossiers.

Je revoi cela ce matin et te remet le code tel que je pense qu'il doit être
mis.

Si tu as du temps pour regarder cela se serait vraiment cool de ta part.

Merci par avance, G'Claire

"G''Claire" a écrit :

MichDenis,

Merci pour ton aide.

Donc j'ai apporté tes dernières modifications, suite a ma demande.

J'ai du mal faire quelque chose ou je met pas les bon dossier dans les
variables :

1) Dans ce code :

Option Explicit
Private Declare Function SetCurrentDirectoryA Lib _
"kernel32" (ByVal lpPathName As String) As Long
Dim Tblo()
Dim A As Long
'---------------------------------------------
Public Sub ChDirNet(szPath As String)
Dim lReturn As Long
lReturn = SetCurrentDirectoryA(szPath)
If lReturn = 0 Then Err.Raise vbObjectError + 1, "Error setting path."
End Sub
'---------------------------------------------
Sub Liste_Des_Fichiers()
Dim X
Dim Répertoire As String

Répertoire = "c:UsersDMDocuments"
ChDirNet Répertoire
A = 0
Répertoire = ChoixDossierFichier & ""
If Répertoire <> "" Then
Call Contenu_Répertoire(Répertoire)
Call FoldersInFolder(Répertoire)
Call Traitement
End If

End Sub
'------------------------------------------

---> Je le met au tout début en remplacement de ce qu'il y avait déjà, et je
met quoi ici, je m'embrouille un peu.

Répertoire = "c:UsersDMDocuments"


2) Dans ce code
Répertoire = "c:denis"
If Dir(Répertoire, vbDirectory) = "" Then
MsgBox "Répertoire : " & Répertoire & _
" inexistant." & vbCrLf & "Opération annulée."
Exit Sub
End If

--> Je le met a quel niveau dans la procédure, car je pense que cela a son
importante.

Et Répertoire = "c:denis"

Dois-je le mettre a nouveau, ou cela correspond a autre chose?

Désolé mais je m'embrouille un pneu la.

Voici comment j'ai fait et a priori j'ai du mal faire, lol.



'Déclaration des variables dans le haut du module
Option Explicit
Private Declare Function SetCurrentDirectoryA Lib _
"kernel32" (ByVal lpPathName As String) As Long
Dim Tblo()
Dim A As Long
'---------------------------------------------
Public Sub ChDirNet(szPath As String)
Dim lReturn As Long
lReturn = SetCurrentDirectoryA(szPath)
If lReturn = 0 Then Err.Raise vbObjectError + 1, "Error setting path."
End Sub
'---------------------------------------------
Sub Liste_Des_Fichiers()
Dim X
Dim Répertoire As String

Répertoire = "O:Spectacle années en cours" 'Quelle destination ?
ChDirNet Répertoire
A = 0
Répertoire = ChoixDossierFichier & ""
If Répertoire <> "" Then
Call Contenu_Répertoire(Répertoire)
Call FoldersInFolder(Répertoire)
Call Traitement
End If
Répertoire = "O:Spectacle années en cours" 'Quelle destination ?

If Dir(Répertoire, vbDirectory) = "" Then
MsgBox "Répertoire : " & Répertoire & _
" inexistant." & vbCrLf & "Opération annulée."
Exit Sub
End If

End Sub
'------------------------------------------

'----------------------------------------
Sub FoldersInFolder(myFolderName As String)

Dim FSO As Object
Dim myBaseFolder As Object
Dim myFolder As Object

Set FSO = CreateObject("scripting.filesystemobject")
Set myBaseFolder = FSO.GetFolder(myFolderName)
For Each myFolder In myBaseFolder.SubFolders
Call Contenu_Répertoire(myFolder.Path & "")
Call FoldersInFolder(myFolder.Path)
Next myFolder

End Sub
'----------------------------------------
Sub Contenu_Répertoire(Chemin As String)
Dim Fichier As String
Fichier = Dir(Chemin & "*.mp3")
Do While Fichier <> ""
A = A + 1
ReDim Preserve Tblo(A)
Tblo(A) = Chemin & Fichier
Fichier = Dir()
Loop
End Sub
'----------------------------------------
Function ChoixDossierFichier$(Optional Racine)
Dim objShell, objFile, Chemin, SecuriteSlash, FlagChoix&, Msg$

If IsMissing(Racine) Then Racine = "O:Spectacle années en cours"
Msg = "Choisissez le fichier à ouvrir :"
Set objShell = CreateObject("Shell.Application")
Set objFile = objShell.BrowseForFolder(&H0&, Msg, &H4000, Racine)
On Error Resume Next
Chemin = objFile.ParentFolder.ParseName(objFile.Title).Path & ""
ChoixDossierFichier = Chemin
End Function
'----------------------------------------
Sub Traitement()
Dim Txt As String, i As Long, Fil As String
Dim Tablo1, Tablo2, Organisateurs As String
Dim Annee As String, A As String, B As String
Dim C As String, D As String, e As String, F As String
Dim G, f1, Ligne As Long, Choix ', fso, dossier

For i = 1 To UBound(Tblo)
Fil = Tblo(i)
Tablo1 = Split(Fil, "")
Tablo2 = Split(Tablo1(UBound(Tablo1)), "-")
If UBound(Tablo1) = 6 And _
UBound(Tablo2) = 3 And _
InStr(1, UCase(Fil), UCase(Txt)) > 0 Then
'Organisateurs
Organisateurs = Tablo1(2)
'Année
Annee = Tablo1(1)
Annee = Right(Annee, 4)
'A : N° de la partie -> (Donnée récupérée par rapport au dossier)
A = Tablo1(4)
A = Application.Substitute(A, "Partie ", "")
'B : N° du ballet -> (Donnée récupérée avec le nom du fichier)
B = Tablo2(0)
'C : Nom du prof -> (Données récupérées par rapport au dossier)
C = Tablo1(5)
'D : Groupe d 'élève -> (Données récupérées avec le nom du fichier)
D = Tablo2(1)
'E : Interprètes -> (Données récupérées avec le nom du fichier)
e = Tablo2(3)
e = Left(e, Len(e) - 4)
'F : Titres -> (Données récupérées avec le nom du fichier)
F = Tablo2(2)
'G : La durée de la chanson --> (Données récupérées avec le poids du fichier)
'(39934/176400)1024#2 sec soit 3'52 sec
G = FileLen(Fil)
G = G / 176400 / 60 / 60 / 24
'NUMEROTATION DES FICHIERS
With Sheets("Tool_Planning")
Application.ScreenUpdating = False
.Range("E6") = Organisateurs
Ligne = .Cells(.Cells.Rows.Count, 1).End(xlUp).Row + 1
.Cells(Ligne, "A") = A
.Cells(Ligne, "B") = B
.Cells(Ligne, "C") = C
.Cells(Ligne, "D") = D
.Cells(Ligne, "E") = e
.Cells(Ligne, "F") = F
.Cells(Ligne, "G") = G
.Cells(Ligne, "G").NumberFormat = "mm:ss"
If Range("A14").Value = 0 Then Exit Sub
Range("A14:G14").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Sort Key1:=Range("A14"), Order1:=xlAscending, _
Header:=xlNo, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom
Range("A14").Select
End With
End If
Next i
End Sub
'----------------------------------------


Merci encore, G'Claire


"G''Claire" a écrit :

> Salut a toute et tous.
>
> Je ne sais si vous allé pouvoire m'aider, mais je suis vraiment bien embété
> et je n'arrive pas a me dépatouiller d'un truc qui fonctionné.
>
> Cela fait prés de 5 Ans que j'utilise un fichier EXCEL pour générer des
> feuilles, pour des spéctacles de danse ou autres, et la cela bloque sur la
> procédure de vérification des fichiers audio dont le nom me sert a remplire
> mes feuilles.
>
> Donc voici comment je manipule cela .
>
> 1) J'ai un bouton qui lance la procédure "RecupDonneesBallets"
>
> 2) Cela m'ouvre une fenetre de sélection du dossier principale : Spectacle
> années en cours.
>
> 3) La je sélectione le dossier de ma prestation (Chaque dossier de
> prestation est constituer de la même manière):
>
> Dans ce dossier il y a :
>
> a) Tous les dosseir par professeurs avec leur musques dedans au format MP3
> b) Un dossier "Musiques pour le gala" qui me sert pour la suite de la
> procédure.
>
> Et dans ce dossier il y a X parties de la prestation (Cela me sert a
> remplire des informations dans les feuilles):
>
> Partie 1
> Partie 2
> Partie 3
>
>
> Et dans chaque partie il y a le nom de chaque professeurs de danse (Cela me
> sert a remplire des informations dans les feuilles)
>
> Et dans chaque dossiers il y a des fichier musiquaux, donc ces fichier me
> sservent juste a extraire le nom du fichier pour remplire des informations
> dans les feuilles)
>
> J'espère que c'est claire.
>
> Donc voici la procédure et cela bloque à : With Application.FileSearch.
>
> Et comme erreur j'ai :
>
> Erreur d'éxécution '445'
> Cet objet ne gère pas action.
>
>
>
> Sub RecupDonneesBallets()
> Dim txt As String, i As Long, fil As String
> Dim tablo1, tablo2, Organisateurs As String
> Dim Annee As String, a As String, b As String, c As String, d As String, e
> As String, f As String
> Dim g, f1, ligne As Long, choix ', fso, dossier
> With Sheets("Tool_Planning")
> Application.ScreenUpdating = False
> Range("A14:G14").Select
> Range(Selection, Selection.End(xlDown)).Select
> Selection.ClearContents
> Range("A14").Select
> End With
> txt = "Musiques pour le gala"
> choix = ChoixDossierFichier("O:Spectacle années en cours")
> If choix <> "" Then
> With Application.FileSearch
> .LookIn = choix
> .Filename = "*.MP3"
> .SearchSubFolders = True
> If .Execute > 0 Then
> For i = 1 To .FoundFiles.Count
> fil = .FoundFiles(i)
> tablo1 = Split(fil, "")
> tablo2 = Split(tablo1(UBound(tablo1)), "-")
> If UBound(tablo1) = 6 And _
> UBound(tablo2) = 3 And _
> InStr(1, UCase(fil), UCase(txt)) > 0 Then
> 'Organisateurs
> Organisateurs = tablo1(2)
> 'Année
> Annee = tablo1(1)
> Annee = Right(Annee, 4)
> 'A : N° de la partie -> (Donnée récupérée par rapport au dossier)
> a = tablo1(4)
> a = Application.Substitute(a, "Partie ", "")

MichDenis.

J'espère ne pas t'avoir offusqué sur mes dernières réponses, et si c'est le
cas je m'en excuse.

Non, en faite je ne veux pas faire de conversions de fichiers.

Je ne sais si cela est permis, mais serait il possible de te donner le
fichier en question, car je n'arrive pas a t'expliquer clairement problème et
se serait peut être plus facile de cette manière.

Car pour moi je suis plus que bloquer, je dois remmetre se fiches au plus
tard samedi matin.

Je te remercie beaucoup, salutations, G'Claire


"MichDenis" a écrit :

Pour faire la gestion des "tags" des fichiers MP3, il y a
des gratuiciels sur le web pour faire ce type de boulot.
Celui-ci que tu peux télécharger à cette adresse :
http://www.clubic.com/telecharger-fiche12753-mp3tag.html

Il y a aussi le logiciel Foobar2000 téléchargeable gratuitement à partir
du Web qui permet d'éditer les "Tags" en plus de convertir des plages
de musiques d'un format à un autre. Exemple : fichier Wav en MP3
Très performant... et en plus le code est ouvert !

Sur le site de Misange, Excelabo.Net , fais une recherche, je crois que
tu trouveras des exemples voire des fichiers Excel tout prêt.

Si rien de ce qui précède ne correspond à ton besoin, il faudra définir précisément
ce que tu recherches à faire avec l'aide d'Excel




"G''Claire" <jacouille@discution.microsoft.com> a écrit dans le message de groupe de
discussion : 98E0B2E0-4BE1-4BB5-A87E-B29F86EBF598@microsoft.com...
Le groupe de discution , MichDenis,

Donc, j'ai encore regardé cette nuité ce code.

Pour ce qui est de mon probleme de temps, j'ai retrouvé, a la base ce
fichier était plus prévue pour des musiques en .wav, et la formule de calcule
était cela :

'G : La durée de la chanson --> (Données récupérées avec le poids du fichier)
'(39934/176400)1024#2 sec soit 3'52 sec
G = FileLen(Fil)
G = G / 176400 / 60 / 60 / 24

Mais de plus en plus on me donne des MP3, donc cela correspond a plus rien.

Serait il possible de faire un truc qui, suivant l'extension me calcul le
temps de la zik, pour le MP je crois qu'il a le tag du fichier qui pourrai
peut être faire l'affaire, a voir je suis spécialiste.

Voici un code que j'utilise de temps en temps pour lister des fichier d'un
répertoire et remplire les célulles suivant des tag, je l'avais récupéré sur
le net.

Option Explicit

Sub MP3_Listing()
Dim sPath As String: sPath = GetShellFolder
If sPath = "" Then Exit Sub
If Dir(sPath, vbDirectory) = "" Then Exit Sub
Dim Headers(35), x%, y&, i&, p$, n$, oFile As Object
Dim objShell As Object, oFolder As Object
Set objShell = CreateObject("Shell.Application")
Set oFolder = objShell.Namespace(CStr(sPath))
Application.ScreenUpdating = False
'Workbooks.Add
For i = 0 To 34
Headers(i) = oFolder.GetDetailsOf(oFolder.Items, i)
Select Case i
Case 22, 18, 20, 33, 17, 4, 0, 9, 19, 10, 21 '0 To 50, si on veux tout lister
x = x + 1
Cells(1, x) = Headers(i)
End Select
Next
y = 1
For Each oFile In oFolder.Items
p = oFile.Path: n = oFile.Name
x = 0: y = y + 1
For i = 0 To 34
Select Case i
Case 22, 18, 20, 33, 17, 4, 0, 9, 19, 10, 21 ' 0 To 50, si
on veux tout lister
x = x + 1
Cells(y, x) = oFolder.GetDetailsOf(oFile, i)
With ActiveSheet
.Hyperlinks.Add .Range("A" & y), Hlink(p), , n, n
End With
End Select
Next
Next
Range("A2").Select
ActiveWindow.FreezePanes = True
Rows("1:1").Font.Bold = True
Cells.Columns.AutoFit
Range("A1").Select
Set oFolder = Nothing: Set objShell = Nothing
End Sub
'-----------------------------------------
Private Function GetShellFolder() As String
Const Title = "Sélectionnez un répertoire !"
Dim oSHA As Object, oSF As Object, oItem As Object
On Error GoTo 1
Set oSHA = CreateObject("Shell.Application")
Set oSF = oSHA.BrowseForFolder(0, Title, &H1 Or &H10, &H11)
If InStr(TypeName(oSF), "Folder") <> 1 Then Exit Function
For Each oItem In oSF.parentfolder.Items
If oItem.Name = oSF.Title Then
GetShellFolder = oItem.Path
Exit Function
End If
Next
GetShellFolder = oSF.Title
Set oSF = Nothing: Set oSHA = Nothing
Exit Function
1: MsgBox "Error: " & Err.Number & vbLf & Err.Description, 48
End Function
'-----------------------------------------
Private Function Hlink(p As String) As String
Hlink = "file:///" & Replace(Replace(p, " ", "%20"), "", "/")
End Function

A moins qu'il éxiste un moyen de faire cette récupération du temps du
morceau valable pour tous les type de fichier audio, je ne sais pas.

Pour ce qui est du code que tu m'avait donné, je t'avoue avoir un peu de
mal, car je ne sais pas si je met les bonnes direction pour les dossiers.

Je revoi cela ce matin et te remet le code tel que je pense qu'il doit être
mis.

Si tu as du temps pour regarder cela se serait vraiment cool de ta part.

Merci par avance, G'Claire

"G''Claire" a écrit :

> MichDenis,
>
> Merci pour ton aide.
>
> Donc j'ai apporté tes dernières modifications, suite a ma demande.
>
> J'ai du mal faire quelque chose ou je met pas les bon dossier dans les
> variables :
>
> 1) Dans ce code :
>
> Option Explicit
> Private Declare Function SetCurrentDirectoryA Lib _
> "kernel32" (ByVal lpPathName As String) As Long
> Dim Tblo()
> Dim A As Long
> '---------------------------------------------
> Public Sub ChDirNet(szPath As String)
> Dim lReturn As Long
> lReturn = SetCurrentDirectoryA(szPath)
> If lReturn = 0 Then Err.Raise vbObjectError + 1, "Error setting path."
> End Sub
> '---------------------------------------------
> Sub Liste_Des_Fichiers()
> Dim X
> Dim Répertoire As String
>
> Répertoire = "c:UsersDMDocuments"
> ChDirNet Répertoire
> A = 0
> Répertoire = ChoixDossierFichier & ""
> If Répertoire <> "" Then
> Call Contenu_Répertoire(Répertoire)
> Call FoldersInFolder(Répertoire)
> Call Traitement
> End If
>
> End Sub
> '------------------------------------------
>
> ---> Je le met au tout début en remplacement de ce qu'il y avait déjà, et je
> met quoi ici, je m'embrouille un peu.
>
> Répertoire = "c:UsersDMDocuments"
>
>
> 2) Dans ce code
> Répertoire = "c:denis"
> If Dir(Répertoire, vbDirectory) = "" Then
> MsgBox "Répertoire : " & Répertoire & _
> " inexistant." & vbCrLf & "Opération annulée."
> Exit Sub
> End If
>
> --> Je le met a quel niveau dans la procédure, car je pense que cela a son
> importante.
>
> Et Répertoire = "c:denis"
>
> Dois-je le mettre a nouveau, ou cela correspond a autre chose?
>
> Désolé mais je m'embrouille un pneu la.
>
> Voici comment j'ai fait et a priori j'ai du mal faire, lol.
>
>
>
> 'Déclaration des variables dans le haut du module
> Option Explicit
> Private Declare Function SetCurrentDirectoryA Lib _
> "kernel32" (ByVal lpPathName As String) As Long
> Dim Tblo()
> Dim A As Long
> '---------------------------------------------
> Public Sub ChDirNet(szPath As String)
> Dim lReturn As Long
> lReturn = SetCurrentDirectoryA(szPath)
> If lReturn = 0 Then Err.Raise vbObjectError + 1, "Error setting path."
> End Sub
> '---------------------------------------------
> Sub Liste_Des_Fichiers()
> Dim X
> Dim Répertoire As String
>
> Répertoire = "O:Spectacle années en cours" 'Quelle destination ?
> ChDirNet Répertoire
> A = 0
> Répertoire = ChoixDossierFichier & ""
> If Répertoire <> "" Then
> Call Contenu_Répertoire(Répertoire)
> Call FoldersInFolder(Répertoire)
> Call Traitement
> End If
> Répertoire = "O:Spectacle années en cours" 'Quelle destination ?
>
> If Dir(Répertoire, vbDirectory) = "" Then
> MsgBox "Répertoire : " & Répertoire & _
> " inexistant." & vbCrLf & "Opération annulée."
> Exit Sub
> End If
>
> End Sub
> '------------------------------------------
>
> '----------------------------------------
> Sub FoldersInFolder(myFolderName As String)
>
> Dim FSO As Object
> Dim myBaseFolder As Object
> Dim myFolder As Object
>
> Set FSO = CreateObject("scripting.filesystemobject")
> Set myBaseFolder = FSO.GetFolder(myFolderName)
> For Each myFolder In myBaseFolder.SubFolders
> Call Contenu_Répertoire(myFolder.Path & "")
> Call FoldersInFolder(myFolder.Path)
> Next myFolder
>
> End Sub
> '----------------------------------------
> Sub Contenu_Répertoire(Chemin As String)
> Dim Fichier As String
> Fichier = Dir(Chemin & "*.mp3")
> Do While Fichier <> ""
> A = A + 1
> ReDim Preserve Tblo(A)
> Tblo(A) = Chemin & Fichier
> Fichier = Dir()
> Loop
> End Sub
> '----------------------------------------
> Function ChoixDossierFichier$(Optional Racine)
> Dim objShell, objFile, Chemin, SecuriteSlash, FlagChoix&, Msg$
>
> If IsMissing(Racine) Then Racine = "O:Spectacle années en cours"
> Msg = "Choisissez le fichier à ouvrir :"
> Set objShell = CreateObject("Shell.Application")
> Set objFile = objShell.BrowseForFolder(&H0&, Msg, &H4000, Racine)
> On Error Resume Next
> Chemin = objFile.ParentFolder.ParseName(objFile.Title).Path & ""
> ChoixDossierFichier = Chemin
> End Function
> '----------------------------------------
> Sub Traitement()
> Dim Txt As String, i As Long, Fil As String
> Dim Tablo1, Tablo2, Organisateurs As String
> Dim Annee As String, A As String, B As String
> Dim C As String, D As String, e As String, F As String
> Dim G, f1, Ligne As Long, Choix ', fso, dossier
>
> For i = 1 To UBound(Tblo)
> Fil = Tblo(i)
> Tablo1 = Split(Fil, "")
> Tablo2 = Split(Tablo1(UBound(Tablo1)), "-")
> If UBound(Tablo1) = 6 And _
> UBound(Tablo2) = 3 And _
> InStr(1, UCase(Fil), UCase(Txt)) > 0 Then
> 'Organisateurs
> Organisateurs = Tablo1(2)
> 'Année
> Annee = Tablo1(1)
> Annee = Right(Annee, 4)
> 'A : N° de la partie -> (Donnée récupérée par rapport au dossier)
> A = Tablo1(4)
> A = Application.Substitute(A, "Partie ", "")
> 'B : N° du ballet -> (Donnée récupérée avec le nom du fichier)
> B = Tablo2(0)
> 'C : Nom du prof -> (Données récupérées par rapport au dossier)
> C = Tablo1(5)
> 'D : Groupe d 'élève -> (Données récupérées avec le nom du fichier)
> D = Tablo2(1)
> 'E : Interprètes -> (Données récupérées avec le nom du fichier)
> e = Tablo2(3)
> e = Left(e, Len(e) - 4)

| serait il possible de te donner le
| fichier en question

A ) je ne suis pas offusqué... cependant, il y a des gratuiciels
sur le web plus performant qu'Excel pour ce type de boulot
quoique je ne sais pas avec précision ce que tu veux faire !

B ) le forum est un lieu "d'échange et de partage". En leur nom,
on fait beaucoup de choses sur ce forum, mais, moi, je ne fais
pas de "debuggage" personnalisé d'application. Ceci étant, qui
sait, tu auras peut-être quelqu'un d'autre qui t'offrira de te
dépanner !

C'était ma dernière intervention sur ce fil.

MichDenis,

Je comprends, merci beaucoup, G'Claire

"MichDenis" a écrit :

| serait il possible de te donner le
| fichier en question

A ) je ne suis pas offusqué... cependant, il y a des gratuiciels
sur le web plus performant qu'Excel pour ce type de boulot
quoique je ne sais pas avec précision ce que tu veux faire !

B ) le forum est un lieu "d'échange et de partage". En leur nom,
on fait beaucoup de choses sur ce forum, mais, moi, je ne fais
pas de "debuggage" personnalisé d'application. Ceci étant, qui
sait, tu auras peut-être quelqu'un d'autre qui t'offrira de te
dépanner !

C'était ma dernière intervention sur ce fil.

Salut tout le monde.

Suite a l'aide de MichDenis (Que je remercie) et en regardant plus
clairement ces explications a tête plus reposé et pas dans les
précipitations, car de ce fait je faisait mal les modifications, voila ou
j'en suis, si quelqu'un passe par la.

Donc, la recherche se fait bien.
L'importation aussi.

Par contre si je fais annuler, pendant la demande, cela me donne une erreur :

Erreur '52'
Nom ou numéro de fichier incorrect

Et le débuggeur s'arrète sur cette ligne de code.

Fichier = Dir(Chemin & "*.wav")

Comme je puis y remédier.


Pour ce qui concerne le reste de ma demande qui n'étais pas trés claire, et
je vais essayer d'être plus explicite.

Donc jusqu'a présent je n'avait que des fichier en wave, car s'est moi qui
faisait les montage audio, donc la recherche se faisait, avec ce code :

Fichier = Dir(Chemin & "*.wav")

Et le calcul de temps avec celui- la :

'G : La durée de la chanson --> (Données récupérées avec le poids du fichier)
'(39934/176400)1024#2 sec soit 3'52 sec
G = FileLen(Fil)
G = G / 176400 / 60 / 60 / 24

Maintenant que les gens m'envoie leur fichier et pour que ceux si soient
moins lourd pour l'envoie, ils mes les envoient en MP3.

Donc ce que j'aimerais c'est lors du choix que les deux soit possible et que
automatique le calcule se fassent par rapport aux extentions.

Sachant qu'ils peut y avoir les deux.

Voici la structure de mes dossiers (Ca n'est pas le fichier Excel), sur le
disque :
O:Spectacle années en cours

http://cjoint.com/?fDxcO8DjO7

Je vous remercie par avance beaucoup, salutations, G'Claire



"G''Claire" a écrit :

MichDenis,

Je comprends, merci beaucoup, G'Claire

"MichDenis" a écrit :

> | serait il possible de te donner le
> | fichier en question
>
> A ) je ne suis pas offusqué... cependant, il y a des gratuiciels
> sur le web plus performant qu'Excel pour ce type de boulot
> quoique je ne sais pas avec précision ce que tu veux faire !
>
> B ) le forum est un lieu "d'échange et de partage". En leur nom,
> on fait beaucoup de choses sur ce forum, mais, moi, je ne fais
> pas de "debuggage" personnalisé d'application. Ceci étant, qui
> sait, tu auras peut-être quelqu'un d'autre qui t'offrira de te
> dépanner !
>
> C'était ma dernière intervention sur ce fil.
>
>
>
>
>

Salut a vous

Donc, il y aurais peut être une piste.

Dans ce code :


Code:
'----------------------------------------
Sub Liste_Des_Fichiers()
Dim X
Dim Répertoire As String
Répertoire = "O:Spectacle années en cours"
A = 0
Répertoire = ChoixDossierFichier(Répertoire) & ""
If Répertoire <> "" Then
Call Contenu_Répertoire(Répertoire)
Call FoldersInFolder(Répertoire)
Call Traitement
Else
Exit Sub
End If
End Sub
'----------------------------------------La : If Répertoire <> "" Then

Cela dit Si "Répertoire" est différant de vide ?

Et bien il ne peut être vide sachant que :

Répertoire = ChoixDossierFichier(Répertoire) & ""

Il est rempli par ""

Donc j'ai fait le test en mettant

If Répertoire <> "" Then


Mais es-ce vraiment la solution?????

Je vais de mon coté essayer de voir si vous avez plus d'infos, merci par
avance, G'Claire

"G''Claire" a écrit :

Salut a toute et tous.

Je ne sais si vous allé pouvoire m'aider, mais je suis vraiment bien embété
et je n'arrive pas a me dépatouiller d'un truc qui fonctionné.

Cela fait prés de 5 Ans que j'utilise un fichier EXCEL pour générer des
feuilles, pour des spéctacles de danse ou autres, et la cela bloque sur la
procédure de vérification des fichiers audio dont le nom me sert a remplire
mes feuilles.

Donc voici comment je manipule cela .

1) J'ai un bouton qui lance la procédure "RecupDonneesBallets"

2) Cela m'ouvre une fenetre de sélection du dossier principale : Spectacle
années en cours.

3) La je sélectione le dossier de ma prestation (Chaque dossier de
prestation est constituer de la même manière):

Dans ce dossier il y a :

a) Tous les dosseir par professeurs avec leur musques dedans au format MP3
b) Un dossier "Musiques pour le gala" qui me sert pour la suite de la
procédure.

Et dans ce dossier il y a X parties de la prestation (Cela me sert a
remplire des informations dans les feuilles):

Partie 1
Partie 2
Partie 3


Et dans chaque partie il y a le nom de chaque professeurs de danse (Cela me
sert a remplire des informations dans les feuilles)

Et dans chaque dossiers il y a des fichier musiquaux, donc ces fichier me
sservent juste a extraire le nom du fichier pour remplire des informations
dans les feuilles)

J'espère que c'est claire.

Donc voici la procédure et cela bloque à : With Application.FileSearch.

Et comme erreur j'ai :

Erreur d'éxécution '445'
Cet objet ne gère pas action.



Sub RecupDonneesBallets()
Dim txt As String, i As Long, fil As String
Dim tablo1, tablo2, Organisateurs As String
Dim Annee As String, a As String, b As String, c As String, d As String, e
As String, f As String
Dim g, f1, ligne As Long, choix ', fso, dossier
With Sheets("Tool_Planning")
Application.ScreenUpdating = False
Range("A14:G14").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Range("A14").Select
End With
txt = "Musiques pour le gala"
choix = ChoixDossierFichier("O:Spectacle années en cours")
If choix <> "" Then
With Application.FileSearch
.LookIn = choix
.Filename = "*.MP3"
.SearchSubFolders = True
If .Execute > 0 Then
For i = 1 To .FoundFiles.Count
fil = .FoundFiles(i)
tablo1 = Split(fil, "")
tablo2 = Split(tablo1(UBound(tablo1)), "-")
If UBound(tablo1) = 6 And _
UBound(tablo2) = 3 And _
InStr(1, UCase(fil), UCase(txt)) > 0 Then
'Organisateurs
Organisateurs = tablo1(2)
'Année
Annee = tablo1(1)
Annee = Right(Annee, 4)
'A : N° de la partie -> (Donnée récupérée par rapport au dossier)
a = tablo1(4)
a = Application.Substitute(a, "Partie ", "")
'B : N° du ballet -> (Donnée récupérée avec le nom du fichier)
b = tablo2(0)
'C : Nom du prof -> (Données récupérées par rapport au dossier)
c = tablo1(5)
'D : Groupe d 'élève -> (Données récupérées avec le nom du fichier)
d = tablo2(1)
'E : Interprètes -> (Données récupérées avec le nom du fichier)
e = tablo2(3)
e = Left(e, Len(e) - 4)
'F : Titres -> (Données récupérées avec le nom du fichier)
f = tablo2(2)
'G : La durée de la chanson --> (Données récupérées avec le poids du fichier)
'(39934/176400)1024#2 sec soit 3'52 sec
g = FileLen(fil)
g = g / 176400 / 60 / 60 / 24
'NUMEROTATION DES FICHIERS
With Sheets("Tool_Planning")
Application.ScreenUpdating = False
.Range("E6") = Organisateurs
ligne = .Cells(.Cells.Rows.Count, 1).End(xlUp).Row + 1
.Cells(ligne, "A") = a
.Cells(ligne, "B") = b
.Cells(ligne, "C") = c
.Cells(ligne, "D") = d
.Cells(ligne, "E") = e
.Cells(ligne, "F") = f
.Cells(ligne, "G") = g
.Cells(ligne, "G").NumberFormat = "mm:ss"
If Range("A14").Value = 0 Then Exit Sub

Range("A14:G14").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Sort Key1:=Range("A14"), Order1:=xlAscending, _
Header:=xlNo, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom
Range("A14").Select
End With
End If
Next i
End If
End With
End If
Application.ScreenUpdating = True
Call creer_feuille

End Sub

J'espère vraiment être assez claire afin que vous puissiez me dépanner, car
la je nage complètement.

Cette procédure je ne l'ai pas écrite et je ne me rappel plus qui me la
faite, c'est un fichier ou beaucoup d'internaute m'ont aidé.

Si besoin est je peux fournire le fichier complet, il n'y a rien de
confidentiel.

Sincères salutations, G'Claire