Trouver l'extension d'un fichier

[lepigoennier]

Bonjour à tous,

Je cherche à trouver l'extension d'un fichier afin de créer un lien hypertexte dans un fichier Excel. Dans le document joint, lorsque Macro 1 est exécutée, nous avons les différents nom de dossiers ainsi que le chemin où le trouver. Par contre, étant donné que j'ai différents types de documents, je ne peux pas, en concaténant, mettre une seule extension. Est-ce que quelqu'un peut m'aider à trouver l'extension et l'inscrire dans la colonne extension?

Merci

 

[Dranreb]

Re : Trouver l'extension d'un fichier

Bonjour
Écrivez peut être cette fonction :

Function EXTEN(ByVal Racine As String, ByVal NomF As String) As String
EXTEN = Split(Dir(Racine & "\" & NomF & ".*"), ".")(1)
End  Function

Et mettez quelque part une instruction du genre:

Feuil1.[H2:H228].FormulaR1C1 =  "=EXTEN(R1C6&RC3&""XXX"",RC2)"

 

[lepigoennier]

Re : Trouver l'extension d'un fichier

Cours 101 pour très débutant comme moi :

Comment je l'insère ton code dans le code suivant? SI je l'insère à la fin, il me demande de mettre un "End Sub" et si j'en met un je ne sais pas comment appeler le code.

Un très gros merci d'avance

Sub Macro1()
'
Columns("C:E").Select
Selection.Insert Shift:=xlToRight
Range("E1").FormulaR1C1 = "c:\test vb\"
Range("C2").FormulaR1C1 = "=LEFT(RC[-1],3)"

Range("C2").Select
Selection.AutoFill Destination:=Range("C2:C228")
Range("C2:C228").Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Range("D2").Select
Application.CutCopyMode = False

ActiveCell.FormulaR1C1 = "=CONCATENATE(R1C5,RC[-1],""XXX\"",RC[-2],""."")"
Range("D2").Select
Selection.AutoFill Destination:=Range("D2228")
Range("D2228").Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Columns("E:E").Select
Selection.Insert Shift:=xlToRight
Range("E1").FormulaR1C1 = "lien hypertexte"

Range("E2").Select
ActiveCell.FormulaR1C1 = "=HYPERLINK(RC[-1],RC[-3])"
Range("E2").Select
Selection.Copy
Range("E3:E10").Select
ActiveSheet.Paste
Range("E2:E10").Select
Application.CutCopyMode = False
Selection.Copy
Columns("C").Select
Selection.EntireColumn.Hidden = True

End Sub

 

[Dranreb]

Re : Trouver l'extension d'un fichier

Non mais c'est une Function à part, donc après un End Sub. Elle sera invoquée lorsqu'elle sera installée dans une formule de la forme =EXEN(etc.

 

[Pierrot93]

Re : Trouver l'extension d'un fichier

Bonjour,

même problèmatique que celle évoquée ici ?
https://www.excel-downloads.com/threads/hyperlien-extension-variable.213278/

préférable de rester sur le même fil dans ce cas...

bonne journée
@+

 

[Si...]

Re : Trouver l'extension d'un fichier

salut

puisque déjà fait ... : pas besoin de l'extension pour créer les liens quand les fichiers sont bien dans le dossier spécifié (code changé et complété)

 

[lepigoennier]

Re : Trouver l'extension d'un fichier

Ça ne fonctionne pas, mais merci quand même. Finalement, j'ai créé un lien qui ouvre le dossier sans ouvrir le document.

 

[Dranreb]

Re : Trouver l'extension d'un fichier

Bonjour.
Pourquoi ? Je vous avais donné une solution qui doit logiquement marcher.
Si… aussi d'ailleurs sauf qu'à mon avis légèrement plus longue.

Function Exten(ByVal Racine As String, ByVal NomF As String) As String
Dim Z As String: Z = Racine & "\" & NomF & ".*"
NomF = Dir(Z)
If NomF = "" Then MsgBox "Il n'existe pas de fichier :" & vbLf & Z, , "Exten": Exit Function
Exten = Split(NomF, ".")(1)
End Function

Sub test()
ActiveSheet.[C2:C3].FormulaR1C1 = "=Exten(RC1,RC2)"
End Sub

En l'exécutant, ma sub test affiche ceci :

Il n'existe pas de fichier :
C:\NImporte\Quoi.*

puis je trouve ça en colonne C, les colonne A et B étant préalablement renseignées :

Chemin	Fichier	Exten
C:\Nimporte	Quoi
C:\Documents and Settings\luck\Mes documents\XLD	Outidx	xls

 

[lepigoennier]

Re : Trouver l'extension d'un fichier

Super ça marche. Un gros merci