Inclure fichier

Bonjour a tous ,

(Stagiaire)

Je vous explique mon problème, je m’occupe des agents d’une entreprise sur excel,

J’ai ma base de donnée agent et une macro qui m’envoi sur la feuille « fiche agent » avec toute les info sur celui-ci (nom,prénom,matricule…)

J’ai besoin d’une macro qui via un bouton me permet d’inclure un fichier (.doc . pdf)

Dans la fiche agent(excel) que le fichier apparaisse et pendant son inclusion que le fichier inclus s’enregistre automatiquement dans un répertoire défini, sous un nom défini qui commencera toujour par FMA_le matricul qui est en B19_la date sous format yyyy/mm/dd

Que l’on puisse sélectionner un des fichiers inclus puis avec un autre bouton l’ouvrir

voila j'ai trouvé sa mais il y a plein de symbole --"

je ne sais pas les enlever .

quelqu'un pourait m'aider a le modifier afin qu'il face ce que je veux ..

merci .


module :

'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:\Documents and Settings\rm715079\Bureau\Inaptitude\CR entretiens" & extn For Output As #1
Print #1, txtfin
Close #1

'ouverture du fichier (pour voir le résultat)
ThisWorkbook.FollowHyperlink "C:\Documents and Settings\rm715079\Bureau\Inaptitude\CR entretiens" & extn, , True
'le fichier est enregistré sur C:\Documents and Settings\rm715079\Bureau\Inaptitude\CR entretiens, 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

feuille : 
Private Sub CommandButton1_Click()
récupère_le_fichier
End Sub

Private Sub CommandButton2_Click()
enregistre_un_fichier
End Sub
Rechercher des sujets similaires à "inclure fichier"