ouverture de fichier texte sur excel

Sub Ouvrir_fichier()
  Dim szFile As String
  Dim szLine As String
  Dim tabl() As String
  Dim szR As String
  Dim iCols As Integer
  Dim iA As Integer
  Dim iFileNo As Integer
  Dim iLines As Integer
  Dim strInstring As String
  Dim intInstring As Integer
'  szDefaultDir = Cells(2, 3)
'  ChDir szDefaultDir

  
  vrtFiles = Application.GetOpenFilename('*.*, *.*', , 'Fichier prn', , True)
  Application.ScreenUpdating = False
  For Each fileToOpen In vrtFiles ' Peu ouvrir plus d'un fichier
  If fileToOpen <> False Then
    bolStopAddSheet = True
    szShortName = fileToOpen
    szXLSfile = fileToOpen & '.prn'
    Workbooks.Add
    Rem ActiveWorkbook.SaveAs szXLSfile
    iFileNo = FreeFile
    Open fileToOpen For Input As #iFileNo
    iLines = 1
    While Not EOF(iFileNo)
        Line Input #iFileNo, szLine
        szLine = Trim(szLine)
        While Left(szLine, 1) = Chr(9)
              szLine = Mid(szLine, 2, Len(szLine))
        Wend
        While Right(szLine, 1) = Chr(9)
              szLine = Mid(szLine, 1, Len(szLine) - 1)
        Wend
        For intChar = 1 To 4 ' Cette boucle sert a chercher la prochaine occurance du caractere de séparation
          Select Case intChar
                 Case 1
                      intInstring = InStr(1, szLine, Chr(9)) 'Tabulation
                 Case 2
                      intInstring = InStr(1, szLine, Chr(32)) 'Space
          End Select
          If intInstring > 1 Then
             strInstring = Mid(szLine, intInstring, 1)
             Exit For
          End If
      Next intChar
      szR = SplitFullCabane(tabl, szLine, strInstring, iLines)
      iLines = iLines + 1
      Application.StatusBar = 'Importing Row ' & _
      ActiveCell.Row & ' of text file ' '& iFileNo
    Wend
    Close #iFileNo
  End If
  Sheets(1).Select
  Next fileToOpen
End Sub

Function SplitFullCabane(tabstrTableau() As String, strLigne As String, strSeparateur As String, intLines As Integer)

Dim nLoop As Integer
ReDim tabstrTableau(0, 254)
iSheet = 1
nLoop = 0
If strSeparateur <> Empty Then
While InStr(strLigne, strSeparateur) > 0
    tabstrTableau(0, nLoop) = Trim(Left(strLigne, InStr(strLigne, strSeparateur) - 1))
    strLigne = Mid(strLigne, InStr(strLigne, strSeparateur) + 1)
    
    While Left(strLigne, 1) = strSeparateur
        strLigne = Mid(strLigne, 2)
    Wend
Wend
End If
tabstrTableau(0, nLoop) = strLigne
Sheets(iSheet).Range(Sheets(iSheet).Cells(intLines, 1), Sheets(iSheet).Cells(intLines, 255)) = tabstrTableau
ReDim tabstrTableau(0, 0)
ReDim tabstrTableau(0, 254)

End Function


Philippe