selection d'un fichier

[oliv67]

je souhaite faire un import de texte dans un fichier excel.

pour cela je souhaite selectionner un fichier via GetOpenFilename

Sub ouverturefichier()
Dim fichier As Variant
fileToOpen = Application _
.GetOpenFilename('Text Files (*.txt), *.txt')
If fileToOpen <> False Then
MsgBox 'Open ' & fileToOpen
fichier = fileToOpen
End If
End Sub

mais je ne sais pas comment faire ensuite, j'ai un message d'erru m'indiquant que le fichier d'origine n'est pas trouvé.


suite du code.....
Private Sub CommandButton1_Click()

Cells.Select
Selection.ClearContents

ouverturefichier

With ActiveSheet.QueryTables.Add(Connection:= _
'TEXT;fileToOpen', Destination:=Range('A1'))

.Name = 'Tesop840'
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 932
.TextFileStartRow = 14
.TextFileParseType = xlFixedWidth
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileFixedColumnWidths = Array(20, 8, 31, 6, 33, 7, 1, 6)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With

Columns('A:A').Select
Selection.Delete shift:=xlToLeft
Range('A1').Select

SupprimeRow


'supression des ligne non numérique
Application.ScreenUpdating = False
For c = Range('A65536').End(xlUp).Row To 2 Step -1
If Not IsNumeric(Cells(c, 'a')) Then
Cells(c, 'a').EntireRow.Delete shift:=xlUp
End If
Next
Application.ScreenUpdating = True


End Sub
Sub SupprimeRow()
Dim DerLgn As Integer, Lgn As Integer
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
With ActiveSheet
DerLgn = .Range('A65536').End(xlUp).Row
End With
For Lgn = DerLgn To 2 Step -1
If Cells(Lgn, 1).Value = '' Then
Cells(Lgn, 1).EntireRow.Select
Selection.EntireRow.Delete shift:=xlUp
End If
Next
Application.Calculation = xlCalculationAutomatic
[a1].Select
End Sub

 

[MichelXld]

bonjour

tu peux tester cette synthaxe


Function ouvertureFichier() As String
Dim Fichier As Variant
fileToOpen = Application _
.GetOpenFilename('Text Files (*.txt), *.txt')
If fileToOpen <> False Then
MsgBox 'Open ' & fileToOpen
ouvertureFichier = fileToOpen
End If
End Function

Private Sub CommandButton1_Click()
Cells.Select
Selection.ClearContents

With ActiveSheet.QueryTables.Add(Connection:= _
'TEXT;' & ouvertureFichier, Destination:=Range('A1'))

.Name = 'Tesop840'
.FieldNames = True

.....


bonne journée
MichelXld

 

[anuky]

Bonjour Oliv67, michelxld et tout le monde,

Voici une autre solution pour importer un fichier texte :

Sub ImportfichierTexte()


Dim FileToOpen As Variant
Dim tmp As Variant

tmp = ActiveWorkbook.Name


'affiche la boîte de dialogue 'Ouvrir' en ne montrant que les fichiers texte et garde le chemin du fichier en mémoir sans l'ouvrir
FileToOpen = Application.GetOpenFilename('Fichiers texte (*.txt), *.txt', , , , False)
If FileToOpen <> False Then

'Importe le fichier texte dont l'adresse a été récupéré précédament dans une nouvelle feuille excel avec la virgule comme séparateur
Workbooks.OpenText Filename:=FileToOpen, comma:=True

'Copie les données et ferme le classeur créé sans l'enregistrer
Application.DisplayAlerts = False
Cells.Select
Selection.Copy
ActiveWorkbook.Close

'Sélectionne 'feuil1' du classeur de la macro et y copie les données
Workbooks(tmp).Activate
Sheets('feuil1').Activate
Cells.Select
Selection.ClearContents
Range('A1').Select
ActiveSheet.Paste

Else

Sheets('feuil1').Activate

End If
End sub


A bientôt.

 

[OLIV67]

merci cela fonctionne

mais je souhaite ouvrir un fichier avec extension .lis au lieu de txt

ou alors pouvoir ouvrir les deux extensions
comment faire
Que faut il modifier?

Function ouvertureFichier() As String
Dim Fichier As Variant
fileToOpen = Application _
.GetOpenFilename('Text Files (*.txt), *.txt')
If fileToOpen <> False Then
MsgBox 'Open ' & fileToOpen
ouvertureFichier = fileToOpen
End If
End Function


Merci de votre aide et bonjour à anuky

 

[anuky]

rebonjour à tous,

Voici la fonction que tu recherche, normalement tu peux mettre autant d'extension que tu veux

Function ouvertureFichier() As String
Dim Fichier As Variant
fileToOpen = Application _
.GetOpenFilename('Text Files (*.txt), *.txt, NomAffiché (*.lis),*.lis')
If fileToOpen <> False Then
MsgBox 'Open ' & fileToOpen
ouvertureFichier = fileToOpen
End If
End Function

A bientôt.

 

[OLIV67]

merci