Discussion :

[xavion]

Bonsoir à tous,

Je cherche à trouver une solution viable pour un projet que je dois mener à terme. J'ai réussi la première partie grâce aux différentes rubriques de ce site mais je n'ai rien trouvé sur la partie finale.Je vous explique :

A l'heure actuelle, j'ai un fichier excel qui contient une base de données de 1000 questions pour un examen professionnel (d'ailleurs vous comprendrez que je ne peux pas joindre le fameux fichier pour des raisons assez évidentes). A l'aide d'une macro, j'arrive à générer un fichier word qui contient 19 questions aléatoires. Cette épreuve consiste en la compréhension en langue anglaise de certains bouts de phrase.
Je cherche maintenant à compiler les mp3 correspondants (je les ai tous en fichier séparé) en un seul fichier mp3 qui correspondra au fichier word généré aléatoirement.
Je n'ai aucune idée de comment faire cela et si c'est possible.
Autre précision, je voudrais que la procédure marche aussi bien sur mac que sur windows. C'est d'ailleurs pour cela que j'ai programmé en vba.

Merci d'avance et excellente soirée.

[Montor]

les fichier mp3 devront avoir le même fréquence d'échantillonnage quantification ...

module de classe
CFiler

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
Option Explicit
Private fList As New Collection
Private Const BUFF_SIZE = 1024
Private Type gg
    Reserved(BUFF_SIZE - 1) As Byte
End Type
 
Public Sub Add(AFilename As String)
  fList.Add AFilename, CStr(AFilename)
End Sub
 
Public Sub Export(AFilename As String)
Dim C As Long
Dim n As Byte
Dim f As gg
Dim I As Long
Dim BL As Long, Sz As Long
  Open AFilename For Binary As #1
  For C = 1 To fList.Count
     GetAttr fList(C)
     Open fList(C) For Binary As #2
         Sz = LOF(2) Mod BUFF_SIZE
         BL = LOF(2) \ BUFF_SIZE
         If BL > 0 Then
           For I = 0 To BL - 1
              Get #2, , f
              Put #1, , f
           Next
         End If
         If Sz > 0 Then
           For I = 0 To Sz - 1
              Get #2, , n
              Put #1, , n
           Next
         End If
      Close #2
  Next
  Close #1
End Sub

code de test

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Dim k As New CFiler
k.Add "File1.mp3"
k.Add "File2.mp3"
k.Export "Result.mp3"

[xavion]

Merci Montor je teste ça sur le champ en essayant de comprendre....
Je te tiens au courant

[Montor]

Pour utiliser le code
dans EDI clique sur insertion -module de classe avec le nom CFiler ...
regarde dans le ficher joint ...

[xavion]

Salut,

J'ai fait comme tu m'as dit, je te joins mon code. En fait ca ne me génère pas d'erreurs mais ça ne fait pas le mp3. Comme je ne maîtrise pas encore, je m'en remets à toi merci encore

[Montor]

Dsl je ne peux pas tout tester dans ton fichier certain code ne fonctionne pas chez moi
voici un autre exemple .. tu dois crée un dossier MP3FILES dans le même racine que fichier Excel si tu a un autre nom tu peux le changer selon ton contexte ce nom se trouve dan la fonction GetMp3File ...
je viens de tester sous windows ça fonctionne ...y a tant de solution devant toi

tu peux aussi faire un simple opération de xor pour rendre tes fichiers illisibles au autres personnes ...

[xavion]

Salut Montor,
ton code marche effectivement super bien. Je suis en train de le bidouiller pour qu'il se lance sans taper sur l'userform test mais directement après ma macro random... J'aime bien l'userform qui met la tâche en pourcentage. C'est génial en tout cas merci bcp .
Je te dirai quand ce sera fini et opérationnel dans mon fichier.

[Montor]

tu mélange vba word dans l'excel je doute que tu pu cree un document avec ce code ...

change le code suivant et adapte le ...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Dim wObj As Object
Dim Doc As Object
Dim k As Long
 
    Set wObj = GetObject(, "Word.Application")
 
    If Err <> 0 Then
      Set wObj = CreateObject("Word.Application")
    End If
 
    wObj.Documents.Open ("Vierge_Ecoute.doc")
    Set Doc = wObj.Documents("Vierge_Ecoute")
    'utilise Doc a la place de ActiveDocument
    'reste du code
    '...
 
    Doc.SaveAs ("dfgd.doc")
    Doc.Close
    ...

mais faire attention ces deux fonctions CreateObject et GetObject sont spécification windows il faut bien tester sur un Mac ... sinon tu peu utiliser le format dochtml bien maitrisable

[Montor]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
    Set wObj = GetObject(, "Word.Application")
 
    If Err <> 0 Then
      Set wObj = CreateObject("Word.Application")
    End If

a remplacer par

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
    Set wObj = GetObject(, "Word.Application")
 
    If wObj Is Nothing Then
      ' If GetObject fails, then use CreateObject instead.
      Set wObj = CreateObject("Word.Application")
    End If

[xavion]

tu mélange vba word dans l'excel je doute que tu pu cree un document avec ce code ...

change le code suivant et adapte le ...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Dim wObj As Object
Dim Doc As Object
Dim k As Long
 
    Set wObj = GetObject(, "Word.Application")
 
    If Err <> 0 Then
      Set wObj = CreateObject("Word.Application")
    End If
 
    wObj.Documents.Open ("Vierge_Ecoute.doc")
    Set Doc = wObj.Documents("Vierge_Ecoute")
    'utilise Doc a la place de ActiveDocument
    'reste du code
    '...
 
    Doc.SaveAs ("dfgd.doc")
    Doc.Close
    ...

mais faire attention ces deux fonctions CreateObject et GetObject sont spécification windows il faut bien tester sur un Mac ... sinon tu peu utiliser le format dochtml bien maitrisable

Ca marche pourtant Montor. Je créée ce que je veux en document word. Ca marche nickel.
Je voudrais juste réussir à incorporer ton code comme je l'ai décrit et j'ai fini mon job

[Montor]

hein héros ...
a mon humble avis voici la partie incriminé du code ...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
   'saisie de l'en-tête
   Selection.Goto What:=wdGoToPage, Which:=wdGoToFirst
    wObj.ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
    With wObj.Selection.HeaderFooter.Range
    .Text = RefExam & " " & NumSerie
    .ParagraphFormat.Alignment = wdAlignParagraphCenter
    End With

tu
crée un signet avec "header" comme nom dans le fichier word pour insérer le titre directement

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
 
'Ouverture du documents word
Lresult = Replace(ActiveWorkbook.FullName, ActiveWorkbook.Name, "")
 
   Set wObj = CreateObject("Word.Application")
   On Error GoTo FinalizeApp
   Set Doc = wObj.Documents.Add(Template:= _
          Lresult & "Vierge_Ecoute.doc", NewTemplate _
            :=False, DocumentType:=0)
 
 
For k = 1 To 19
RowQuestion = Sheets("Liste").Range("A" & k).Value
'intitulé de la question
    Texte(k) = Sheets("Base").Range("I" & RowQuestion).Value
    Texte(k) = Replace(Texte(k), "/", Chr(13))
    Texte(k) = Replace(Texte(k), "*", Chr(9))
    Doc.Bookmarks("Question" & k).Range.Text = Texte(k)
'Réponse
    TexteReponse(k) = Sheets("Base").Range("J" & RowQuestion).Value
    TexteReponse(k) = Replace(TexteReponse(k), "/", Chr(13) & Chr(9) & Chr(9) & Chr(9) & Chr(9))
    Doc.Bookmarks("Reponse" & k).Range.Text = TexteReponse(k)
   Next k
   'Saisie de la référence de l'examen dans la correction
   Doc.Bookmarks("refexam").Range.Text = RefExam
   'saisie de l'en-tête
    Doc.Bookmarks("header").Range.Text = RefExam & " " & NumSerie
    Doc.SaveAs Lresult & RefExam & ".doc"
    Doc.Close
    Call MP3
 
'effacer la feuille liste sans message d'acquittement
Application.DisplayAlerts = False
ActiveWorkbook.Sheets("Liste").Delete
Application.DisplayAlerts = True
 
 
MsgBox "le programme a genere une ecoute de traffic reel avec succes"
ActiveWorkbook.Save
 
FinalizeApp:
    wObj.Quit
End Sub

une autre sulution cest d'appeler un macro Word depuis l'Excel en lui passant les parametres titre lest des réponses liste des questions
macro dans le fichier Word

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Sub RenderDoc(ATitle As String, QuizList() As String, RepList() As String)
Dim I As Long
    For I = 1 To 19
       ' QuizList(i)
    Next
    ' creer l'entete ici
 
End Sub

code dans l'Excel

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
 
   Set wObj = CreateObject("Word.Application")
   On Error GoTo FinalizeApp
   Set Doc = wObj.Documents.Add(Template:= _
          Lresult & "Vierge_Ecoute.doc", NewTemplate _
            :=False, DocumentType:=0)
 
 
For k = 1 To 19
RowQuestion = Sheets("Liste").Range("A" & k).Value
'intitulé de la question
    Texte(k) = Sheets("Base").Range("I" & RowQuestion).Value
    Texte(k) = Replace(Texte(k), "/", Chr(13))
    Texte(k) = Replace(Texte(k), "*", Chr(9))
'Réponse
    TexteReponse(k) = Sheets("Base").Range("J" & RowQuestion).Value
    TexteReponse(k) = Replace(TexteReponse(k), "/", Chr(13) & Chr(9) & Chr(9) & Chr(9) & Chr(9))
   Next k
    'Exécuter macro de fichier word
    wObj.Run "RenderDoc", RefExam & " " & NumSerie,Texte,TexteReponse
    Doc.SaveAs Lresult & RefExam & ".doc"
    Doc.Close
...

sur tout il ne faut pas mettre du code vba word dans l'Excel