référence dans le code au nom d'un fichier sans l'extension

Bonjour à tous,

Voici un code que j'ai bidouillé à partir d'une proposition de JB sur son
site. L'idée, c'est d'inscrire le nom du seul fichier inscrit dans un
répertoire. Si par maladresse il y a plusieurs fichiers dans ce répertoire,
l'un d'entre eux est choisi (je ne sais pas trop comment... apparemment, le
dernier par ordre alphabétique)

Il y a certainement des choses bizarre dans ce code car j'ai travaillé par
essais-erreurs, et en rajoutant des morceaux avec l'enregistreur de macros.
Je suis assez fier de moi, c'est la première fois que j'arrive à faire un
truc pareil.... Je sais, c'est ridicule ;-))

J'ai besoin de vous car il ne me manque qu'une chose : je voudrais que le nom
de fichier ne comporte pas l'extension. Pourriez-vous m'aider?

' ------------------------------------------------------

Sub inscrire_fichier()
Application.ScreenUpdating = False
racine = "C:Monchemin"
If racine = "" Then Exit Sub
Range("A4").Clear
Range("A4").Select
Set fs = CreateObject("Scripting.FileSystemObject")
Set dossier_racine = fs.getfolder(racine)
Lit_dossier dossier_racine, 1
Selection.Font.Underline = xlUnderlineStyleNone
With Selection.Font
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
End With
Range("A1").Select
End Sub
Sub Lit_dossier(ByRef dossier, ByVal niveau)

ActiveCell.Offset(0, 0).Select
For Each f In dossier.Files
nom_fich = f.Name
ActiveSheet.Hyperlinks.Add Anchor:=Selection, _
Address:=dossier.Path & "" & nom_fich, TextToDisplay:Þcal(niveau)
& nom_fich
' ActiveSheet.Hyperlinks.Add Anchor:=Selection, _
Address:=dossier.Path & "" & nom_fich, TextToDisplay:=nom_fich

Next
End Sub
Function decal(niv)
decal = String(3 * niv, " ")
End Function

' -------------------------------------------------------

Merci d'avance

Greg

Bonjour.
Si j'ai tout compris :

Sub Lit_dossier(ByRef dossier, ByVal niveau)

ActiveCell.Offset(0, 0).Select
For Each f In dossier.Files
nom_fich = f.Name
nom_fich = ""
Tablo = Split(f.Name)
For i = 0 To UBound(Tablo) - 1
nom_fich = nom_fich & Tablo(i)
Next i
ActiveSheet.Hyperlinks.Add Anchor:=Selection, _

Next
End Sub

je pense que la suppression de l'extension n'est souhaitée que pour
l'affichage du lien, si l'on clique il faut ouvrir le fichier avec
l'extension. le code ci-dessous a été adapté pour cela.

le fichier test.xls sera affiché test, mais si l'on clique dessus, c'est
test.xls qui s'ouvrira.

DanielCo was thinking very hard :

Bonjour.
Si j'ai tout compris :

Sub Lit_dossier(ByRef dossier, ByVal niveau)

ActiveCell.Offset(0, 0).Select
For Each f In dossier.Files
nom_fich = f.Name
nom_fich = ""

nom_fich = nom_fich & Tablo(i)
Next i
ActiveSheet.Hyperlinks.Add Anchor:=Selection, _

Address:=dossier.Path & "" & f.Name, _
TextToDisplay:Þcal(niveau)& nom_fich

Next
End Sub

h2so4 explained on 12/12/2010 :

je pense que la suppression de l'extension n'est souhaitée que pour
l'affichage du lien, si l'on clique il faut ouvrir le fichier avec
l'extension. le code ci-dessous a été adapté pour cela.

le fichier test.xls sera affiché test, mais si l'on clique dessus, c'est
test.xls qui s'ouvrira.

correction

DanielCo was thinking very hard :

Bonjour.
Si j'ai tout compris :

Sub Lit_dossier(ByRef dossier, ByVal niveau)

ActiveCell.Offset(0, 0).Select
For Each f In dossier.Files
nom_fich = f.Name
nom_fich = ""

Tablo = Split(f.Name,".")
For i = LBound(Tablo) To UBound(Tablo) - 1

nom_fich = nom_fich & Tablo(i)
Next i
ActiveSheet.Hyperlinks.Add Anchor:=Selection, _

Address:=dossier.Path & "" & f.Name, _
TextToDisplay:Þcal(niveau)& nom_fich

Next
End Sub

--
h2so4
ca PAN
pique DORA
.

Bonsoir,

Effectivement, j'avais retourné le premier code de Daniel dans tous l es
sens, et rien n'y faisait. On arrive donc à :

Sub Lit_dossier(ByRef dossier, ByVal niveau)
ActiveCell.Offset(0, 0).Select
For Each f In dossier.Files
nom_fich = f.Name
nom_fich = ""
Tablo = Split(f.Name, ".")
For i = LBound(Tablo) To UBound(Tablo) - 1
nom_fich = nom_fich & Tablo(i)
Next i
ActiveSheet.Hyperlinks.Add Anchor:=Selection, _
Address:=dossier.Path & "" & f.Name, _
TextToDisplay:=decal(niveau) & nom_fich
Next
End Sub