Discussion :

[felixismad]

Bonjour à tous,

alors voila, j'ai trouvé beaucoup de discutions sur ce sujet mais je ne trouve pas ce que je veux.

Alors est ce qu'il serait possible d'encapsuler un fichier son dans un fichier excel ? (je crois que oui mais je ne trouve pas comment)
Et surtout est il possible de contrôler l'activation de ces sons pas VBA une fois encapsuler ?


Si cela n'est pas possible, savez vous si il est possible de lier un fichier son à un classeur excel dans un dossier?
(L'idée est que le fichier son "suive" le classeur si il est envoyé par mail, coupé et collé ...)

Bonne journée,

[QuestVba]

Bonjour,

Voici déjà un document à lire

Effectivement, l'idéal est de partir d'un fichier Excel contenant tous les fichiers annexes sous forme encapsulée. L'ouverture du fichier Excel provoquera l'installation automatique des fichiers annexes. Il te faut donc être capable d'insérer (sélectionner un fichier pour qu'il soit insérer dans le fichier Excel) et de "dés-insérer" (recopier sur le disque dur un des fichiers inclus dans la page Excel) à la demande par macro, des fichiers dans une page Excel.

Le fichier à insérer est stocké octet par octet, tout simplement dans les cellules du fichier Excel.

Le fichier à insérer est ouvert en lecture par Open (le nom complet du fichier est SonExcel) :
Open SonExcel For Binary Access Read As #1
puis lu par une certaine quantité d'octets grâce à Input :
okt = Input(1024, #1)

[felixismad]

Bonjour et merci pour cette réponse.

Donc j'ai bien tout lu ... mais comment faire la première partie pour encapsuler des fichiers.
Et surtout quelles sont les commandes pour déencapsuler au niveau du disque dur en VBA?

Bonne soirée,

[QuestVba]

Re-,

J'ai dû chercher pour retrouver quelque chose que j'avais déjà vu.

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
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
Attribute VB_Name = "fichiers_inclus"
'J@C octobre 2002
Const nouvcar = "£¤"

Sub enregistre_un_fichier()

'choix du fichier à télécharger
fich = Application.GetOpenFilename(, , "choisissez le fichier à enregistrer")
If fich = False Then Exit Sub

'détermination de la première ligne vide pour y insérer le fichier
lin = Cells.Find("*", , , , , xlPrevious).Row + 1
'détermination du nom du fichier (sans le chemin d'accès)
'et stockage dans la première colonne
nomfich = fich
Do While InStr(nomfich, "\") > 0
nomfich = Right(nomfich, Len(nomfich) - InStr(nomfich, "\"))
Loop
Cells(lin, 1) = nomfich & " (" & Format(FileLen(fich) / 1000, "0.0") & " ko)"
'détermination de l'extension et stockage dans la deuxième cellule
extn = Right(fich, 4)
If Left(extn, 1) <> "." Then extn = "." & extn
Cells(lin, 2) = extn

'ouverture du fichier en lecture binaire
Open fich For Binary Access Read As #1
longueur = LOF(1)

'lecture par paquets de 5*1024 octets (pour aller plus vite)
nbcar = 5 * 1024
col = 3
encor:
If longueur > nbcar Then
truc = Input(nbcar, #1)
longueur = longueur - nbcar
'codage par la fonction nume et inscription dans la cellule suivante
Cells(lin, col).Value = "'" & nume(truc, nouvcar)
col = col + 1
GoTo encor

Else
'lecture codage et inscription des derniers octets
truc = Input(longueur, #1)
Cells(lin, col).Value = "'" & nume(truc, nouvcar)
End If

Close #1
Cells(lin, 1).Select
End Sub


Sub récupère_le_fichier()
Dim textfin As String

'les données du fichier sont dans la ligne sélectionnée
lin = ActiveCell.Row
extn = Cells(lin, 2)

'récupération des octets
txtfin = txtfin & truc
txtfin = ""
For col = 3 To Rows(lin).Find("*", , , , , xlPrevious).Column
'utilisation de la fonction rnum pour récupérer les octets
txtfin = txtfin & rnum(Cells(lin, col).Value, nouvcar)
Next

'création du fichier avec ouverture en écriture et copie des données
Open "c:\rien" & extn For Output As #1
Print #1, txtfin
Close #1

'ouverture du fichier (pour voir le résultat)
ThisWorkbook.FollowHyperlink "c:\rien" & extn, , True
'le fichier est enregistré sur C:\ sous rien.txt, rien.wav, rien.html...
End Sub


Function nume(txt, nvcar)
Do While InStr(txt, Chr(0)) > 0
txt = Left(txt, InStr(txt, Chr(0)) - 1) & nvcar & Right(txt, Len(txt) - InStr(txt, Chr(0)))
Loop
nume = txt
End Function


Function rnum(txt, nvcar)
Do While InStr(txt, nvcar) > 0
txt = Left(txt, InStr(txt, nvcar) - 1) & Chr(0) & Right(txt, Len(txt) - InStr(txt, nvcar) + 1 - Len(nvcar))
Loop
rnum = txt
End Function

[felixismad]

Bonjour,

et bien, ce code est quand même pas mal compliqué du tout!
Je ne suis pas capable de faire un tel travail, je t'en remercie !
Je pense réussir à faire ce que je souhaite si tout se passe bien.

J'ai cependant un petit problème avec ton code,

2 petites choses:
-la 1er ligne : Attribute VB_Name = "fichiers_inclus"
indique une erreur et cela ne fonctionne pas. Je ne sais pas pourquoi.

Ensuite, pensant que c'était juste un commentaire. J'ai supprimé cela et pas de chance une erreur apparaît.
L'erreur numéro 91 : Variable objet ou variable de bloc with non défini.

Une idée ?
en tout ca merci beaucoup pour ton aide,

[QuestVba]

ceci en PJ