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

Le
Greg
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
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
DanielCo
Le #22916541
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, _
Address:=dossier.Path & "" & nom_fich,
TextToDisplay:Þcal(niveau) & nom_fich
Next
End Sub




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
h2so4
Le #22917151
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 = ""
Tablo = Split(f.Name)
For i = 0 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
.
h2so4
Le #22917281
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
.
Greg
Le #22917441
Bonsoir,

Effectivement, j'avais retourné le premier code de Daniel dans tous les
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:Þcal(niveau) & nom_fich
Next
End Sub

Merci beaucoup pour votre aide!

Greg

"h2so4" sh6No.24803$
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
.


Gloops
Le #22918071
Greg a écrit, le 12/12/2010 18:11 :
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:Þcal(niveau) & nom_fich
Next
End Sub




Bonjour,

Je suppose que dans le module tu fais attention aux indentations ?
C'est plus facile, quand il faut passer derrière ...

C'est ce qui permet de se rendre compte tout de suite qu'on a deux
boucles For imbriquées, plutôt que de voir un rectangle et de se
demander par où on va pouvoir y entrer et ce que signifie ce qu'on a
sous les yeux.
Publicité
Poster une réponse
Anonyme