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
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