Application.GetOpenFilename

bonjour, je cherche le moyen d'afficher en B5, le nom du fichier txt que j'importe, sans le chemin, ni l'extension

actuellement, j'affiche:

C:\Users\dann\Desktop\nappage noir miroir.txt

et je voudrais juste

nappage noir miroir

le code actuel:

Public NameSansExtension As String

Sub SelectionFichier()

Dim LongFilename As String

LongFilename = Application.GetOpenFilename("Text Files (*.txt), *.txt")

ShortFilename " & NameSansExtension (LongFilename)"

[b5] = Application.GetOpenFilename()

End Sub

Function ShortFilename(LongFilename As String) As String

For i = Len(LongFilename) To 1 Step -1

If Mid(LongFilename, i, 1) = "\" Then Exit For

Next

ShortFilename = Mid(LongFilename, i + 1, Len(LongFilename))

NameSansExtension = Mid(ShortFilename, 1, Len(ShortFilename) - 4)

End Function

merci

Bonjour,

Tu pourrais remplacer ta boucle for par une instruction InStrRev(...

salut,

c'est un code que j'ai récupéré et que je tente d'adapter, mais sans résultat, vu mon très bas niveau en vba

Bonjour,

Function ShortFilename(LongFilename As String) As String
    Dim tmp
    tmp = Split(LongFilename, "\")
    ShortFilename = Split(tmp(UBound(tmp)), ".")(0)
End Function

eric

Salut,

Grillé par eriiic (salut !). En complément :

[B5] = ShortFilename(LongFilename)

Cordialement

salut,

je me permets de joindre mon code qui importe mon fichier (désolé ), car je n' arrive pas à le modifier pour intégrer vos lignes sans erreur: ( si en 2 mn vous pouvez m'aider, merci )

Option Explicit

Sub import_donnees()

Dim fich_txt As String

Dim fich_source As String

Application.ScreenUpdating = False

fich_source = ActiveWorkbook.Name

'effacement des données présentes

Feuil1.Range("B7:B" & Feuil1.Cells(Rows.Count, 2).End(xlUp).Row).ClearContents

ChDir ActiveWorkbook.Path

'demande a l'utilisateur de choisir un fichier

fich_txt = Application.GetOpenFilename("Tous les fichiers (*.*),*.*")

'ouverture du fichier txt

Workbooks.OpenText Filename:=fich_txt, Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, Local:=True, Semicolon:=True

'copie des lignes

ActiveWorkbook.Sheets(1).Range("A1:A" & ActiveWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row).Copy 'Workbooks(fich_source).Feuil1.Range("A1")

'collage spéciale des valeurs

Workbooks(fich_source).Sheets(1).[B7].PasteSpecial xlValues

'fermeture du fichier

Application.DisplayAlerts = False

ActiveWorkbook.Close False

Application.DisplayAlerts = True

Range("b2").Select

Application.ScreenUpdating = True

End Sub

Si tu pouvais utiliser la balise Code pour ton code, ce serait un plus.

Et indenter ton code, ce serait un plus mieux !

Si j'ai pas mélangé les versions successives :

Function ShortFilename(LongFilename As String) As String
    Dim tmp
    tmp = Split(LongFilename, "\")
    ShortFilename = Split(tmp(UBound(tmp)), ".")(0)
End Function

Sub import_donnees()
    Dim fich_txt As String
    Application.ScreenUpdating = False
    'effacement des données présentes
    Feuil1.Range("B7:B" & Feuil1.Cells(Rows.Count, 2).End(xlUp).Row).ClearContents
    ChDir ThisWorkbook.Path
    'demande a l'utilisateur de choisir un fichier
    fich_txt = Application.GetOpenFilename("Tous les fichiers (*.*),*.*")
    'ouverture du fichier txt
    Workbooks.OpenText Filename:=fich_txt, Origin:=xlWindows, StartRow:=1, _
     DataType:=xlDelimited, Local:=True, Semicolon:=True
    'copie des lignes
    ActiveWorkbook.Sheets(1).Range("A1:A" & ActiveWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row).Copy 'Workbooks(fich_source).Feuil1.Range("A1")
    'collage spéciale des valeurs
    ThisWorkbook.Sheets(1).[B7].PasteSpecial xlValues
    'fermeture du fichier
    Application.DisplayAlerts = False
    ActiveWorkbook.Close False
    Application.DisplayAlerts = True
    Range("B5") = ShortFilename(fich_txt)
    Application.ScreenUpdating = True
End Sub

A tester.


Une question oubliée : c'est volontairement que tu utilises le nom de code de feuille une fois et plus par la suite ?

merci, impeccable

Rechercher des sujets similaires à "application getopenfilename"