XL 2010 Nom de fichier sans chemin réseau ni extension

Philippe LAMACHE · 12 Août 2019

Bonjour à tous,
Je cherche désespérément à extraire dans une cellule les derniers caractères (longueur variable) entre le dernier "_" et le "."
Voici mon code

Sub Ouvrir_Fichier()
Dim result As String
LectChemin$ = ThisWorkbook.Path
If ActiveLectChemin(LectChemin$) Then
Nom_Fichier = Application.GetOpenFilename("Fichiers Excel, *.xls;*.xlsx")
result = Nom_Fichier
result = Mid(result, 1, Len(result) - 4)
Do While Replace(result, "\", "") <> result
result = Mid(result, 2, Len(result) - 1)
Loop
If Nom_Fichier <> False Then
Workbooks.Open Filename:=Nom_Fichier
End If
Else
Exit Sub
End If
Feuil3.[G1048576].End(xlUp).Offset(1, 0).Value = Nom_Fichier
Nom_Fichier_Court = Nom_Fichier ' Nom_Fichier à raccourcir
Feuil3.[G1048576].End(xlUp).Offset(0, 1).Value = Nom_Fichier_Court
Cells.Copy
ThisWorkbook.Activate
Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Nom_Fichier_Court"
Cells.Select
ActiveSheet.Paste
[A1].Select

Call Ferme_Autre_Fichier
Feuil2.Activate
End Sub

Mon 'Nom_Fichier' me renvoie, selon le cas :
\\cluster02\GRP21\G_METHOD\BOITE\ECV\Liste_des_RGF_Bât 1.xlsx
ou
\\cluster02\GRP21\G_METHOD\BOITE\ECV\Liste_des_RGF_Bâtiment 12.xlsx
ou
...

Je souhaiterais que mon 'Nom_Fichier_Court' me donne seulement :
Bât 1
ou
Bâtiment 12
ou
...

Quelqu'un peut-il m'aider ?
Par avance, merci.

chris · 12 Août 2019

Bonjour

Utilise le principe suivant

VB:

X = InStrRev(Nom_Fichier, "_") + 1
Y = InStrRev(NomFichier, ".") - 1
Nom_Fichier_Court = Mid(NomFichier, X, Y)

Pense ici à mettre ton code dans une balise Code avec le bouton </>

Philippe LAMACHE · 12 Août 2019

Merci Chris mais il me reste le .xlsx
J'ai essayé avec

VB:

Y = InStrRev(Nom_Fichier, ".") - 5

mais cela ne fonctionne pas mieux

pierrejean · 12 Août 2019

Bonjour Philippe

Edit: Salut et bises Chris

Une fonction personnalisée qui pourra t’être utile

VB:

Function LeNom(GrandNom)
For n = Len(GrandNom) To 1 Step -1
If Mid(GrandNom, n, 1) = "." Then a = n
If Mid(GrandNom, n, 1) = "_" Then
    b = n
    LeNom = Mid(GrandNom, b + 1, a - b - 1)
    Exit Function
End If
Next
End Function

Philippe LAMACHE · 12 Août 2019

Bonjour PierreJean,

Merci. par contre je ne sais pas utiliser les fonctions.
Dois-je écrire :

VB:

Nom_Fichier_Court = LeNom(Nom_Fichier)

à la place de ce que me propose Chris ?

Philippe LAMACHE · 12 Août 2019

Re.
Je viens d'essayer (avant ta réponse, désolé) et cela fonctionne.
Merci à vous deux.
Bonne journée.

pierrejean · 12 Août 2019

Re
Apres avoir copié la fonction dans un Module c'est bien la bonne méthode
As-tu essayé ???

Philippe LAMACHE · 12 Août 2019

pierrejean à dit:
Re
Apres avoir copié la fonction dans un Module c'est bien la bonne méthode
As-tu essayé ???

Oui. Cela fonctionne parfaitement. Merci

mapomme · 12 Août 2019

Bonjour à tous,

@chris

Peut-être comme ceci? (coquille sur NomFichier alors que Nom_Fichier) :

VB:

Sub test()
X = InStrRev(Nom_Fichier, "_")
Y = InStrRev(Nom_Fichier, ".")
Nom_Fichier_Court = Mid(Nom_Fichier, X, Y - X)
End Sub

chris · 12 Août 2019

RE à tous

Merci Mapomme, de corriger mes _ oubliés

Staple1600 · 12 Août 2019

Bonsoir le fil,

Histoire de varier les plaisirs

VB:

Sub DaisyXetDesIgrecs()
X = "\\cluster02\GRP21\G_METHOD\BOITE\ECV\Liste_des_RGF_Bât 1.xlsx"
Y = Split(Split(X, "_")(UBound(Split(X, "_"))), ".")
MsgBox Y(0)
End Sub

eriiic · 13 Août 2019

Bonjour,

Staple, à condition de ne pas avoir d'autres "." qui se baladent comme dans :
Liste_des_RGF_Bât.1.xlsx
eric

Staple1600 · 13 Août 2019

Bonsoir,

eriiiic
Moi je passais juste pour un hommage déguisé à H. Léonard
(Je n'avais pas pensé à J.Quartz et à G. Lenorman)

PS: Ayant connu ces temps bénis, j'ai pris l'habitude de n'avoir qu'un point dans un nom de fichier.

eriiic · 13 Août 2019

Bonjour,
Houla, ça ne fait pas partie de mon répertoire ça
eric

XL 2010 Nom de fichier sans chemin réseau ni extension

Philippe LAMACHE

XLDnaute Junior

chris

XLDnaute Barbatruc

Philippe LAMACHE

XLDnaute Junior

pierrejean

XLDnaute Barbatruc

Philippe LAMACHE

XLDnaute Junior

Philippe LAMACHE

XLDnaute Junior

pierrejean

XLDnaute Barbatruc

Philippe LAMACHE

XLDnaute Junior

mapomme

XLDnaute Barbatruc

chris

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

eriiic

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

eriiic

XLDnaute Barbatruc

Discussions similaires