Bonjour G Claire,
Une petite adaptation d'une procédure parue ici de Michel Perron
Tu auras dans un nouveau classeur le :
Nom - Taille du Fichier - Type de Fichier - Sa Durée
à copier dans un module standard et tu exécutes : MP3_listing
(Pas tester si fonctionnel pour les fichiers de type wma.
'----------------------------
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 0 To 2, 27
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
If Right$(n, 4) = ".wav" Or _
Right$(n, 4) = ".mp3" Or _
Right$(n, 4) = ".wma" Then
x = 0: y = y + 1
For i = 0 To 34
Select Case i
Case 0 To 2, 27
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
End If
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
'----------------------------
"G''Claire" a écrit dans le message de groupe de
discussion :
Salut tout le monde.
Tout d'abord merci a tout ceux qui se sont penché sur mon probleme du a la
migration vers EXCEL 2007.
Ce post étant je pense résolu, par la modification de mon code par MichDenis
(Que je remercie beaucoup).
Donc voici ma seconde demande :
Dans l'importation de mes données dans ma feuille Tool_Planning, j'ai une
colonne dédié aux temps des musiques.
Jusqu'a présent étant donné que je faisait moi même les montages audio, je
finalisé tous mes projets audio en WAV.
Maintenant les profs, fond leur montage audio avec leur moyen, et me donne
en généralité de tous suivant le sprofs, donc je peux avoir du MP3, du Wave
et pire du WMA.
Le code que j'utilisé jusqu'a maintenant fonctionné juste pour le Wave, et
était calculé sur le poids du fichier.
Maintenant j'aimerais avoir la possibilité de faire l'import des ces durées
dans ma feuille Tool_Planning et tenant compte qu'il peu y avoir ces 3
extensions.
Voici le code complet (Comprend celui modifié par MichDenis) car je pense
que l'on peu en avoir besoin) :
'Déclaration des variables dans le haut du module
Option Explicit
Dim Tblo()
Dim A As Long
'----------------------------------------
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
'----------------------------------------
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 & "*.wav")
Do While Fichier <> ""
A = A + 1
ReDim Preserve Tblo(A)
Tblo(A) = Chemin & Fichier
Fichier = Dir()
Loop
End Sub
'----------------------------------------
Function ChoixDossierFichier$(Optional ByVal Racine)
Dim objShell, objFile, Chemin, SecuriteSlash, FlagChoix&, Msg$
If IsMissing(Racine) Then Racine = "c:"
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("C4") = Organisateurs
Ligne = .Cells(.Cells.Rows.Count, 1).End(xlUp).Row + 1
.Cells(Ligne, "A") = A
'.Cells(Ligne, "A").NumberFormat = "00"
.Cells(Ligne, "B") = B
'.Cells(Ligne, "B").NumberFormat = "00"
.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
Call Trie_Planning
End With
End If
Next i
End Sub
'----------------------------------------
Serait il possible d'avoir un bon coup de main.
Je vous remercie par avance, G'Claire
Bonjour G Claire,
Une petite adaptation d'une procédure parue ici de Michel Perron
Tu auras dans un nouveau classeur le :
Nom - Taille du Fichier - Type de Fichier - Sa Durée
à copier dans un module standard et tu exécutes : MP3_listing
(Pas tester si fonctionnel pour les fichiers de type wma.
'----------------------------
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 0 To 2, 27
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
If Right$(n, 4) = ".wav" Or _
Right$(n, 4) = ".mp3" Or _
Right$(n, 4) = ".wma" Then
x = 0: y = y + 1
For i = 0 To 34
Select Case i
Case 0 To 2, 27
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
End If
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
'----------------------------
"G''Claire" <jacouille@discution.microsoft.com> a écrit dans le message de groupe de
discussion : 6FBC7ABB-658B-4691-810B-AFC4169DC0DD@microsoft.com...
Salut tout le monde.
Tout d'abord merci a tout ceux qui se sont penché sur mon probleme du a la
migration vers EXCEL 2007.
Ce post étant je pense résolu, par la modification de mon code par MichDenis
(Que je remercie beaucoup).
Donc voici ma seconde demande :
Dans l'importation de mes données dans ma feuille Tool_Planning, j'ai une
colonne dédié aux temps des musiques.
Jusqu'a présent étant donné que je faisait moi même les montages audio, je
finalisé tous mes projets audio en WAV.
Maintenant les profs, fond leur montage audio avec leur moyen, et me donne
en généralité de tous suivant le sprofs, donc je peux avoir du MP3, du Wave
et pire du WMA.
Le code que j'utilisé jusqu'a maintenant fonctionné juste pour le Wave, et
était calculé sur le poids du fichier.
Maintenant j'aimerais avoir la possibilité de faire l'import des ces durées
dans ma feuille Tool_Planning et tenant compte qu'il peu y avoir ces 3
extensions.
Voici le code complet (Comprend celui modifié par MichDenis) car je pense
que l'on peu en avoir besoin) :
'Déclaration des variables dans le haut du module
Option Explicit
Dim Tblo()
Dim A As Long
'----------------------------------------
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
'----------------------------------------
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 & "*.wav")
Do While Fichier <> ""
A = A + 1
ReDim Preserve Tblo(A)
Tblo(A) = Chemin & Fichier
Fichier = Dir()
Loop
End Sub
'----------------------------------------
Function ChoixDossierFichier$(Optional ByVal Racine)
Dim objShell, objFile, Chemin, SecuriteSlash, FlagChoix&, Msg$
If IsMissing(Racine) Then Racine = "c:"
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("C4") = Organisateurs
Ligne = .Cells(.Cells.Rows.Count, 1).End(xlUp).Row + 1
.Cells(Ligne, "A") = A
'.Cells(Ligne, "A").NumberFormat = "00"
.Cells(Ligne, "B") = B
'.Cells(Ligne, "B").NumberFormat = "00"
.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
Call Trie_Planning
End With
End If
Next i
End Sub
'----------------------------------------
Serait il possible d'avoir un bon coup de main.
Je vous remercie par avance, G'Claire
Bonjour G Claire,
Une petite adaptation d'une procédure parue ici de Michel Perron
Tu auras dans un nouveau classeur le :
Nom - Taille du Fichier - Type de Fichier - Sa Durée
à copier dans un module standard et tu exécutes : MP3_listing
(Pas tester si fonctionnel pour les fichiers de type wma.
'----------------------------
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 0 To 2, 27
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
If Right$(n, 4) = ".wav" Or _
Right$(n, 4) = ".mp3" Or _
Right$(n, 4) = ".wma" Then
x = 0: y = y + 1
For i = 0 To 34
Select Case i
Case 0 To 2, 27
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
End If
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
'----------------------------
"G''Claire" a écrit dans le message de groupe de
discussion :
Salut tout le monde.
Tout d'abord merci a tout ceux qui se sont penché sur mon probleme du a la
migration vers EXCEL 2007.
Ce post étant je pense résolu, par la modification de mon code par MichDenis
(Que je remercie beaucoup).
Donc voici ma seconde demande :
Dans l'importation de mes données dans ma feuille Tool_Planning, j'ai une
colonne dédié aux temps des musiques.
Jusqu'a présent étant donné que je faisait moi même les montages audio, je
finalisé tous mes projets audio en WAV.
Maintenant les profs, fond leur montage audio avec leur moyen, et me donne
en généralité de tous suivant le sprofs, donc je peux avoir du MP3, du Wave
et pire du WMA.
Le code que j'utilisé jusqu'a maintenant fonctionné juste pour le Wave, et
était calculé sur le poids du fichier.
Maintenant j'aimerais avoir la possibilité de faire l'import des ces durées
dans ma feuille Tool_Planning et tenant compte qu'il peu y avoir ces 3
extensions.
Voici le code complet (Comprend celui modifié par MichDenis) car je pense
que l'on peu en avoir besoin) :
'Déclaration des variables dans le haut du module
Option Explicit
Dim Tblo()
Dim A As Long
'----------------------------------------
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
'----------------------------------------
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 & "*.wav")
Do While Fichier <> ""
A = A + 1
ReDim Preserve Tblo(A)
Tblo(A) = Chemin & Fichier
Fichier = Dir()
Loop
End Sub
'----------------------------------------
Function ChoixDossierFichier$(Optional ByVal Racine)
Dim objShell, objFile, Chemin, SecuriteSlash, FlagChoix&, Msg$
If IsMissing(Racine) Then Racine = "c:"
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("C4") = Organisateurs
Ligne = .Cells(.Cells.Rows.Count, 1).End(xlUp).Row + 1
.Cells(Ligne, "A") = A
'.Cells(Ligne, "A").NumberFormat = "00"
.Cells(Ligne, "B") = B
'.Cells(Ligne, "B").NumberFormat = "00"
.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
Call Trie_Planning
End With
End If
Next i
End Sub
'----------------------------------------
Serait il possible d'avoir un bon coup de main.
Je vous remercie par avance, G'Claire
Bonjour G Claire,
Une petite adaptation d'une procédure parue ici de Michel Perron
Tu auras dans un nouveau classeur le :
Nom - Taille du Fichier - Type de Fichier - Sa Durée
à copier dans un module standard et tu exécutes : MP3_listing
(Pas tester si fonctionnel pour les fichiers de type wma.
'----------------------------
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 0 To 2, 27
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
If Right$(n, 4) = ".wav" Or _
Right$(n, 4) = ".mp3" Or _
Right$(n, 4) = ".wma" Then
x = 0: y = y + 1
For i = 0 To 34
Select Case i
Case 0 To 2, 27
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
End If
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
'----------------------------
"G''Claire" a écrit dans le message de groupe de
discussion :
Salut tout le monde.
Tout d'abord merci a tout ceux qui se sont penché sur mon probleme du a la
migration vers EXCEL 2007.
Ce post étant je pense résolu, par la modification de mon code par MichDenis
(Que je remercie beaucoup).
Donc voici ma seconde demande :
Dans l'importation de mes données dans ma feuille Tool_Planning, j'ai une
colonne dédié aux temps des musiques.
Jusqu'a présent étant donné que je faisait moi même les montages audio, je
finalisé tous mes projets audio en WAV.
Maintenant les profs, fond leur montage audio avec leur moyen, et me donne
en généralité de tous suivant le sprofs, donc je peux avoir du MP3, du Wave
et pire du WMA.
Le code que j'utilisé jusqu'a maintenant fonctionné juste pour le Wave, et
était calculé sur le poids du fichier.
Maintenant j'aimerais avoir la possibilité de faire l'import des ces durées
dans ma feuille Tool_Planning et tenant compte qu'il peu y avoir ces 3
extensions.
Voici le code complet (Comprend celui modifié par MichDenis) car je pense
que l'on peu en avoir besoin) :
'Déclaration des variables dans le haut du module
Option Explicit
Dim Tblo()
Dim A As Long
'----------------------------------------
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
'----------------------------------------
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 & "*.wav")
Do While Fichier <> ""
A = A + 1
ReDim Preserve Tblo(A)
Tblo(A) = Chemin & Fichier
Fichier = Dir()
Loop
End Sub
'----------------------------------------
Function ChoixDossierFichier$(Optional ByVal Racine)
Dim objShell, objFile, Chemin, SecuriteSlash, FlagChoix&, Msg$
If IsMissing(Racine) Then Racine = "c:"
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("C4") = Organisateurs
Ligne = .Cells(.Cells.Rows.Count, 1).End(xlUp).Row + 1
.Cells(Ligne, "A") = A
'.Cells(Ligne, "A").NumberFormat = "00"
.Cells(Ligne, "B") = B
'.Cells(Ligne, "B").NumberFormat = "00"
.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
Call Trie_Planning
End With
End If
Next i
End Sub
'----------------------------------------
Serait il possible d'avoir un bon coup de main.
Je vous remercie par avance, G'Claire
Bonjour G Claire,
Une petite adaptation d'une procédure parue ici de Michel Perron
Tu auras dans un nouveau classeur le :
Nom - Taille du Fichier - Type de Fichier - Sa Durée
à copier dans un module standard et tu exécutes : MP3_listing
(Pas tester si fonctionnel pour les fichiers de type wma.
'----------------------------
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 0 To 2, 27
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
If Right$(n, 4) = ".wav" Or _
Right$(n, 4) = ".mp3" Or _
Right$(n, 4) = ".wma" Then
x = 0: y = y + 1
For i = 0 To 34
Select Case i
Case 0 To 2, 27
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
End If
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
'----------------------------
"G''Claire" <jacouille@discution.microsoft.com> a écrit dans le message de groupe de
discussion : 6FBC7ABB-658B-4691-810B-AFC4169DC0DD@microsoft.com...
Salut tout le monde.
Tout d'abord merci a tout ceux qui se sont penché sur mon probleme du a la
migration vers EXCEL 2007.
Ce post étant je pense résolu, par la modification de mon code par MichDenis
(Que je remercie beaucoup).
Donc voici ma seconde demande :
Dans l'importation de mes données dans ma feuille Tool_Planning, j'ai une
colonne dédié aux temps des musiques.
Jusqu'a présent étant donné que je faisait moi même les montages audio, je
finalisé tous mes projets audio en WAV.
Maintenant les profs, fond leur montage audio avec leur moyen, et me donne
en généralité de tous suivant le sprofs, donc je peux avoir du MP3, du Wave
et pire du WMA.
Le code que j'utilisé jusqu'a maintenant fonctionné juste pour le Wave, et
était calculé sur le poids du fichier.
Maintenant j'aimerais avoir la possibilité de faire l'import des ces durées
dans ma feuille Tool_Planning et tenant compte qu'il peu y avoir ces 3
extensions.
Voici le code complet (Comprend celui modifié par MichDenis) car je pense
que l'on peu en avoir besoin) :
'Déclaration des variables dans le haut du module
Option Explicit
Dim Tblo()
Dim A As Long
'----------------------------------------
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
'----------------------------------------
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 & "*.wav")
Do While Fichier <> ""
A = A + 1
ReDim Preserve Tblo(A)
Tblo(A) = Chemin & Fichier
Fichier = Dir()
Loop
End Sub
'----------------------------------------
Function ChoixDossierFichier$(Optional ByVal Racine)
Dim objShell, objFile, Chemin, SecuriteSlash, FlagChoix&, Msg$
If IsMissing(Racine) Then Racine = "c:"
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("C4") = Organisateurs
Ligne = .Cells(.Cells.Rows.Count, 1).End(xlUp).Row + 1
.Cells(Ligne, "A") = A
'.Cells(Ligne, "A").NumberFormat = "00"
.Cells(Ligne, "B") = B
'.Cells(Ligne, "B").NumberFormat = "00"
.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
Call Trie_Planning
End With
End If
Next i
End Sub
'----------------------------------------
Serait il possible d'avoir un bon coup de main.
Je vous remercie par avance, G'Claire
Bonjour G Claire,
Une petite adaptation d'une procédure parue ici de Michel Perron
Tu auras dans un nouveau classeur le :
Nom - Taille du Fichier - Type de Fichier - Sa Durée
à copier dans un module standard et tu exécutes : MP3_listing
(Pas tester si fonctionnel pour les fichiers de type wma.
'----------------------------
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 0 To 2, 27
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
If Right$(n, 4) = ".wav" Or _
Right$(n, 4) = ".mp3" Or _
Right$(n, 4) = ".wma" Then
x = 0: y = y + 1
For i = 0 To 34
Select Case i
Case 0 To 2, 27
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
End If
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
'----------------------------
"G''Claire" a écrit dans le message de groupe de
discussion :
Salut tout le monde.
Tout d'abord merci a tout ceux qui se sont penché sur mon probleme du a la
migration vers EXCEL 2007.
Ce post étant je pense résolu, par la modification de mon code par MichDenis
(Que je remercie beaucoup).
Donc voici ma seconde demande :
Dans l'importation de mes données dans ma feuille Tool_Planning, j'ai une
colonne dédié aux temps des musiques.
Jusqu'a présent étant donné que je faisait moi même les montages audio, je
finalisé tous mes projets audio en WAV.
Maintenant les profs, fond leur montage audio avec leur moyen, et me donne
en généralité de tous suivant le sprofs, donc je peux avoir du MP3, du Wave
et pire du WMA.
Le code que j'utilisé jusqu'a maintenant fonctionné juste pour le Wave, et
était calculé sur le poids du fichier.
Maintenant j'aimerais avoir la possibilité de faire l'import des ces durées
dans ma feuille Tool_Planning et tenant compte qu'il peu y avoir ces 3
extensions.
Voici le code complet (Comprend celui modifié par MichDenis) car je pense
que l'on peu en avoir besoin) :
'Déclaration des variables dans le haut du module
Option Explicit
Dim Tblo()
Dim A As Long
'----------------------------------------
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
'----------------------------------------
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 & "*.wav")
Do While Fichier <> ""
A = A + 1
ReDim Preserve Tblo(A)
Tblo(A) = Chemin & Fichier
Fichier = Dir()
Loop
End Sub
'----------------------------------------
Function ChoixDossierFichier$(Optional ByVal Racine)
Dim objShell, objFile, Chemin, SecuriteSlash, FlagChoix&, Msg$
If IsMissing(Racine) Then Racine = "c:"
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("C4") = Organisateurs
Ligne = .Cells(.Cells.Rows.Count, 1).End(xlUp).Row + 1
.Cells(Ligne, "A") = A
'.Cells(Ligne, "A").NumberFormat = "00"
.Cells(Ligne, "B") = B
'.Cells(Ligne, "B").NumberFormat = "00"
.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
Call Trie_Planning
End With
End If
Next i
End Sub
'----------------------------------------
Serait il possible d'avoir un bon coup de main.
Je vous remercie par avance, G'Claire
Bonjour G Claire,
Une petite adaptation d'une procédure parue ici de Michel Perron
Tu auras dans un nouveau classeur le :
Nom - Taille du Fichier - Type de Fichier - Sa Durée
à copier dans un module standard et tu exécutes : MP3_listing
(Pas tester si fonctionnel pour les fichiers de type wma.
'----------------------------
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 0 To 2, 27
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
If Right$(n, 4) = ".wav" Or _
Right$(n, 4) = ".mp3" Or _
Right$(n, 4) = ".wma" Then
x = 0: y = y + 1
For i = 0 To 34
Select Case i
Case 0 To 2, 27
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
End If
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
'----------------------------
"G''Claire" a écrit dans le message de groupe de
discussion :
Salut tout le monde.
Tout d'abord merci a tout ceux qui se sont penché sur mon probleme du a la
migration vers EXCEL 2007.
Ce post étant je pense résolu, par la modification de mon code par MichDenis
(Que je remercie beaucoup).
Donc voici ma seconde demande :
Dans l'importation de mes données dans ma feuille Tool_Planning, j'ai une
colonne dédié aux temps des musiques.
Jusqu'a présent étant donné que je faisait moi même les montages audio, je
finalisé tous mes projets audio en WAV.
Maintenant les profs, fond leur montage audio avec leur moyen, et me donne
en généralité de tous suivant le sprofs, donc je peux avoir du MP3, du Wave
et pire du WMA.
Le code que j'utilisé jusqu'a maintenant fonctionné juste pour le Wave, et
était calculé sur le poids du fichier.
Maintenant j'aimerais avoir la possibilité de faire l'import des ces durées
dans ma feuille Tool_Planning et tenant compte qu'il peu y avoir ces 3
extensions.
Voici le code complet (Comprend celui modifié par MichDenis) car je pense
que l'on peu en avoir besoin) :
'Déclaration des variables dans le haut du module
Option Explicit
Dim Tblo()
Dim A As Long
'----------------------------------------
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
'----------------------------------------
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 & "*.wav")
Do While Fichier <> ""
A = A + 1
ReDim Preserve Tblo(A)
Tblo(A) = Chemin & Fichier
Fichier = Dir()
Loop
End Sub
'----------------------------------------
Function ChoixDossierFichier$(Optional ByVal Racine)
Dim objShell, objFile, Chemin, SecuriteSlash, FlagChoix&, Msg$
If IsMissing(Racine) Then Racine = "c:"
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("C4") = Organisateurs
Ligne = .Cells(.Cells.Rows.Count, 1).End(xlUp).Row + 1
.Cells(Ligne, "A") = A
'.Cells(Ligne, "A").NumberFormat = "00"
.Cells(Ligne, "B") = B
'.Cells(Ligne, "B").NumberFormat = "00"
.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
Call Trie_Planning
End With
End If
Next i
End Sub
'----------------------------------------
Serait il possible d'avoir un bon coup de main.
Je vous remercie par avance, G'Claire
Bonjour G Claire,
Une petite adaptation d'une procédure parue ici de Michel Perron
Tu auras dans un nouveau classeur le :
Nom - Taille du Fichier - Type de Fichier - Sa Durée
à copier dans un module standard et tu exécutes : MP3_listing
(Pas tester si fonctionnel pour les fichiers de type wma.
'----------------------------
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 0 To 2, 27
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
If Right$(n, 4) = ".wav" Or _
Right$(n, 4) = ".mp3" Or _
Right$(n, 4) = ".wma" Then
x = 0: y = y + 1
For i = 0 To 34
Select Case i
Case 0 To 2, 27
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
End If
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
'----------------------------
"G''Claire" <jacouille@discution.microsoft.com> a écrit dans le message de groupe de
discussion : 6FBC7ABB-658B-4691-810B-AFC4169DC0DD@microsoft.com...
Salut tout le monde.
Tout d'abord merci a tout ceux qui se sont penché sur mon probleme du a la
migration vers EXCEL 2007.
Ce post étant je pense résolu, par la modification de mon code par MichDenis
(Que je remercie beaucoup).
Donc voici ma seconde demande :
Dans l'importation de mes données dans ma feuille Tool_Planning, j'ai une
colonne dédié aux temps des musiques.
Jusqu'a présent étant donné que je faisait moi même les montages audio, je
finalisé tous mes projets audio en WAV.
Maintenant les profs, fond leur montage audio avec leur moyen, et me donne
en généralité de tous suivant le sprofs, donc je peux avoir du MP3, du Wave
et pire du WMA.
Le code que j'utilisé jusqu'a maintenant fonctionné juste pour le Wave, et
était calculé sur le poids du fichier.
Maintenant j'aimerais avoir la possibilité de faire l'import des ces durées
dans ma feuille Tool_Planning et tenant compte qu'il peu y avoir ces 3
extensions.
Voici le code complet (Comprend celui modifié par MichDenis) car je pense
que l'on peu en avoir besoin) :
'Déclaration des variables dans le haut du module
Option Explicit
Dim Tblo()
Dim A As Long
'----------------------------------------
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
'----------------------------------------
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 & "*.wav")
Do While Fichier <> ""
A = A + 1
ReDim Preserve Tblo(A)
Tblo(A) = Chemin & Fichier
Fichier = Dir()
Loop
End Sub
'----------------------------------------
Function ChoixDossierFichier$(Optional ByVal Racine)
Dim objShell, objFile, Chemin, SecuriteSlash, FlagChoix&, Msg$
If IsMissing(Racine) Then Racine = "c:"
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("C4") = Organisateurs
Ligne = .Cells(.Cells.Rows.Count, 1).End(xlUp).Row + 1
.Cells(Ligne, "A") = A
'.Cells(Ligne, "A").NumberFormat = "00"
.Cells(Ligne, "B") = B
'.Cells(Ligne, "B").NumberFormat = "00"
.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
Call Trie_Planning
End With
End If
Next i
End Sub
'----------------------------------------
Serait il possible d'avoir un bon coup de main.
Je vous remercie par avance, G'Claire
Bonjour G Claire,
Une petite adaptation d'une procédure parue ici de Michel Perron
Tu auras dans un nouveau classeur le :
Nom - Taille du Fichier - Type de Fichier - Sa Durée
à copier dans un module standard et tu exécutes : MP3_listing
(Pas tester si fonctionnel pour les fichiers de type wma.
'----------------------------
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 0 To 2, 27
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
If Right$(n, 4) = ".wav" Or _
Right$(n, 4) = ".mp3" Or _
Right$(n, 4) = ".wma" Then
x = 0: y = y + 1
For i = 0 To 34
Select Case i
Case 0 To 2, 27
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
End If
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
'----------------------------
"G''Claire" a écrit dans le message de groupe de
discussion :
Salut tout le monde.
Tout d'abord merci a tout ceux qui se sont penché sur mon probleme du a la
migration vers EXCEL 2007.
Ce post étant je pense résolu, par la modification de mon code par MichDenis
(Que je remercie beaucoup).
Donc voici ma seconde demande :
Dans l'importation de mes données dans ma feuille Tool_Planning, j'ai une
colonne dédié aux temps des musiques.
Jusqu'a présent étant donné que je faisait moi même les montages audio, je
finalisé tous mes projets audio en WAV.
Maintenant les profs, fond leur montage audio avec leur moyen, et me donne
en généralité de tous suivant le sprofs, donc je peux avoir du MP3, du Wave
et pire du WMA.
Le code que j'utilisé jusqu'a maintenant fonctionné juste pour le Wave, et
était calculé sur le poids du fichier.
Maintenant j'aimerais avoir la possibilité de faire l'import des ces durées
dans ma feuille Tool_Planning et tenant compte qu'il peu y avoir ces 3
extensions.
Voici le code complet (Comprend celui modifié par MichDenis) car je pense
que l'on peu en avoir besoin) :
'Déclaration des variables dans le haut du module
Option Explicit
Dim Tblo()
Dim A As Long
'----------------------------------------
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
'----------------------------------------
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 & "*.wav")
Do While Fichier <> ""
A = A + 1
ReDim Preserve Tblo(A)
Tblo(A) = Chemin & Fichier
Fichier = Dir()
Loop
End Sub
'----------------------------------------
Function ChoixDossierFichier$(Optional ByVal Racine)
Dim objShell, objFile, Chemin, SecuriteSlash, FlagChoix&, Msg$
If IsMissing(Racine) Then Racine = "c:"
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("C4") = Organisateurs
Ligne = .Cells(.Cells.Rows.Count, 1).End(xlUp).Row + 1
.Cells(Ligne, "A") = A
'.Cells(Ligne, "A").NumberFormat = "00"
.Cells(Ligne, "B") = B
'.Cells(Ligne, "B").NumberFormat = "00"
.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
Call Trie_Planning
End With
End If
Next i
End Sub
'----------------------------------------
Serait il possible d'avoir un bon coup de main.
Je vous remercie par avance, G'Claire
Salut tout le monde.
Tout d'abord merci a tout ceux qui se sont penché sur mon probleme du a
la
migration vers EXCEL 2007.
Ce post étant je pense résolu, par la modification de mon code
par MichDenis
(Que je remercie beaucoup).
Donc voici ma seconde demande :
Dans l'importation de mes données dans ma feuille Tool_Planning, j'ai
une
colonne dédié aux temps des musiques.
Jusqu'a présent étant donné que je faisait moi même
les montages audio, je
finalisé tous mes projets audio en WAV.
Maintenant les profs, fond leur montage audio avec leur moyen, et me donne
en généralité de tous suivant le sprofs, donc je peux
avoir du MP3, du Wave
et pire du WMA.
Le code que j'utilisé jusqu'a maintenant fonctionné juste pour le
Wave, et
était calculé sur le poids du fichier.
Maintenant j'aimerais avoir la possibilité de faire l'import des ces
durées
dans ma feuille Tool_Planning et tenant compte qu'il peu y avoir ces 3
extensions.
Voici le code complet (Comprend celui modifié par MichDenis) car je
pense
que l'on peu en avoir besoin) :
'Déclaration des variables dans le haut du module
Option Explicit
Dim Tblo()
Dim A As Long
'----------------------------------------
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
'----------------------------------------
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 & "*.wav")
Do While Fichier <> ""
A = A + 1
ReDim Preserve Tblo(A)
Tblo(A) = Chemin & Fichier
Fichier = Dir()
Loop
End Sub
'----------------------------------------
Function ChoixDossierFichier$(Optional ByVal Racine)
Dim objShell, objFile, Chemin, SecuriteSlash, FlagChoix&, Msg$
If IsMissing(Racine) Then Racine = "c:"
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("C4") = Organisateurs
Ligne = .Cells(.Cells.Rows.Count, 1).End(xlUp).Row + 1
.Cells(Ligne, "A") = A
'.Cells(Ligne, "A").NumberFormat = "00"
.Cells(Ligne, "B") = B
'.Cells(Ligne, "B").NumberFormat = "00"
.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
Call Trie_Planning
End With
End If
Next i
End Sub
'----------------------------------------
Serait il possible d'avoir un bon coup de main.
Je vous remercie par avance, G'Claire
Salut tout le monde.
Tout d'abord merci a tout ceux qui se sont penché sur mon probleme du a
la
migration vers EXCEL 2007.
Ce post étant je pense résolu, par la modification de mon code
par MichDenis
(Que je remercie beaucoup).
Donc voici ma seconde demande :
Dans l'importation de mes données dans ma feuille Tool_Planning, j'ai
une
colonne dédié aux temps des musiques.
Jusqu'a présent étant donné que je faisait moi même
les montages audio, je
finalisé tous mes projets audio en WAV.
Maintenant les profs, fond leur montage audio avec leur moyen, et me donne
en généralité de tous suivant le sprofs, donc je peux
avoir du MP3, du Wave
et pire du WMA.
Le code que j'utilisé jusqu'a maintenant fonctionné juste pour le
Wave, et
était calculé sur le poids du fichier.
Maintenant j'aimerais avoir la possibilité de faire l'import des ces
durées
dans ma feuille Tool_Planning et tenant compte qu'il peu y avoir ces 3
extensions.
Voici le code complet (Comprend celui modifié par MichDenis) car je
pense
que l'on peu en avoir besoin) :
'Déclaration des variables dans le haut du module
Option Explicit
Dim Tblo()
Dim A As Long
'----------------------------------------
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
'----------------------------------------
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 & "*.wav")
Do While Fichier <> ""
A = A + 1
ReDim Preserve Tblo(A)
Tblo(A) = Chemin & Fichier
Fichier = Dir()
Loop
End Sub
'----------------------------------------
Function ChoixDossierFichier$(Optional ByVal Racine)
Dim objShell, objFile, Chemin, SecuriteSlash, FlagChoix&, Msg$
If IsMissing(Racine) Then Racine = "c:"
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=232 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("C4") = Organisateurs
Ligne = .Cells(.Cells.Rows.Count, 1).End(xlUp).Row + 1
.Cells(Ligne, "A") = A
'.Cells(Ligne, "A").NumberFormat = "00"
.Cells(Ligne, "B") = B
'.Cells(Ligne, "B").NumberFormat = "00"
.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
Call Trie_Planning
End With
End If
Next i
End Sub
'----------------------------------------
Serait il possible d'avoir un bon coup de main.
Je vous remercie par avance, G'Claire
Salut tout le monde.
Tout d'abord merci a tout ceux qui se sont penché sur mon probleme du a
la
migration vers EXCEL 2007.
Ce post étant je pense résolu, par la modification de mon code
par MichDenis
(Que je remercie beaucoup).
Donc voici ma seconde demande :
Dans l'importation de mes données dans ma feuille Tool_Planning, j'ai
une
colonne dédié aux temps des musiques.
Jusqu'a présent étant donné que je faisait moi même
les montages audio, je
finalisé tous mes projets audio en WAV.
Maintenant les profs, fond leur montage audio avec leur moyen, et me donne
en généralité de tous suivant le sprofs, donc je peux
avoir du MP3, du Wave
et pire du WMA.
Le code que j'utilisé jusqu'a maintenant fonctionné juste pour le
Wave, et
était calculé sur le poids du fichier.
Maintenant j'aimerais avoir la possibilité de faire l'import des ces
durées
dans ma feuille Tool_Planning et tenant compte qu'il peu y avoir ces 3
extensions.
Voici le code complet (Comprend celui modifié par MichDenis) car je
pense
que l'on peu en avoir besoin) :
'Déclaration des variables dans le haut du module
Option Explicit
Dim Tblo()
Dim A As Long
'----------------------------------------
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
'----------------------------------------
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 & "*.wav")
Do While Fichier <> ""
A = A + 1
ReDim Preserve Tblo(A)
Tblo(A) = Chemin & Fichier
Fichier = Dir()
Loop
End Sub
'----------------------------------------
Function ChoixDossierFichier$(Optional ByVal Racine)
Dim objShell, objFile, Chemin, SecuriteSlash, FlagChoix&, Msg$
If IsMissing(Racine) Then Racine = "c:"
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("C4") = Organisateurs
Ligne = .Cells(.Cells.Rows.Count, 1).End(xlUp).Row + 1
.Cells(Ligne, "A") = A
'.Cells(Ligne, "A").NumberFormat = "00"
.Cells(Ligne, "B") = B
'.Cells(Ligne, "B").NumberFormat = "00"
.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
Call Trie_Planning
End With
End If
Next i
End Sub
'----------------------------------------
Serait il possible d'avoir un bon coup de main.
Je vous remercie par avance, G'Claire