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