modification code

[danval]

Bonjour,

j'ai un fichier excel qui fait référence plusieurs fois au nom d'un fichier (NTC-OK.txt)

- chargement depuis un site du fichier, sauvegarde en local, ouverture pour rapatrier les données.

j'aimerais utiliser une cellule de la feuille ADMIN que j'ai appelé ND_NomFich et qui contient le nom du fichier.

car j'ai beaucoup de fichier et à chaque fois que j'en crée un il faut que je me tape tout le code pour modifier le nom.

merci pour votre aide.

Daniel

ci joint les différentes lignes ou l'on trouve le fichier.

Sub LireFichierTXT()
   Dim i As Long
   Dim xRepertoire As String
   Dim xNomFichier As String
   Dim iFile As Integer
   Dim xNumSerie As String
   Dim xAdrMail As String
   Dim WS As Worksheet
  ' xRepertoire = Workbooks(ActiveWorkbook.Name).Path & ":"   'Doit terminer avec un ":"  pour mac
  xRepertoire = Workbooks(ActiveWorkbook.Name).Path & "\"    'Doit terminer avec un "\" pour PC
  xNomFichier = "NTC-OK.txt"
   Set WS = Sheets("ADMIN")                 'Feuille où _crire les r_sultats

   'Ouvrir le fichier
  iFile = FreeFile
Open xRepertoire & xNomFichier For Input As #iFile
   'Lecture du fichier et _criture dans Excel
  Lig = 16
   Do Until EOF(iFile)
      Input #iFile, xNumSerie, xAdrMail
      WS.Cells(Lig, "G") = xNumSerie
      WS.Cells(Lig, "H") = xAdrMail
      Lig = Lig + 1
   Loop
   Close #iFile                             'Fermer le fichier
End Sub

Function TestPCAutoris_()
    '----------------------------------------------------------
   '                    Test si fichier ouvert sur PC autoris_
   '----------------------------------------------------------
  
  
   
    TE_L1 = Worksheets("ADMIN").Range("L2").Value
    TE_L3 = Worksheets("ADMIN").Range("L4").Value
    Dim FichierASupprimer As String
    LocalFileName = Workbooks(ActiveWorkbook.Name).Path & "\NTC-OK.txt"
   ' If TE_L1 = 1 Or TE_L3 = 1 Then
  ' xPCOK = True
   Sheets("ADMIN").Range("A1") = 0
  '  Else
  
    xNumSerieDD = Abs(NumSerieDD("C"))
    For f = 1 To Range("Tab_PCOK[Nom]").Count
        'If Environ("Username") = [Tab_PCOK[Nom]].Item(F) Then                     'Cession WINDOWS
       'If Application.UserName = [Tab_PCOK[Nom]].Item(F) Then                    'Option EXCEL
       If xNumSerieDD = [Tab_PCOK[Nom]].Item(f) Then                              'Num_ro Serie DD
           xPCOK = True
            Sheets("ADMIN").Range("A1") = 1
            Exit For
        Else
            xPCOK = False
            Sheets("ADMIN").Range("A1") = 0
        End If
    Next f
    FichierASupprimer = Workbooks(ActiveWorkbook.Name).Path & "\NTC-OK.txt"
Kill FichierASupprimer
   
    If xPCOK = False Then
        xMess = Empty
        xMess = xMess & "Pas autorisé à utiliser ce fichier sur cet ordinateur" & Chr(13) & Chr(13)
        xMess = xMess & "Fermeture imminente du fichier"
        MsgBox xMess, vbCritical, "Pas d'autorisation"
    End If
   
   ' End If
   TestPCAutoris_ = xPCOK
   
  
End Function

 Sub Get_File_From_FTP()
    Dim URL As String
    Dim LocalFileName As String
    Dim ErrorText As String

    URL = "http://monsite.eu/Licences/NTC-OK.txt"
    LocalFileName = Workbooks(ActiveWorkbook.Name).Path & "\NTC-OK.txt"
    B = DownloadFile(UrlFileName:=URL, _
                    DestinationFileName:=LocalFileName, _
                    Overwrite:=OverwriteRecycle, _
                    ErrorText:=ErrorText)
    If B = False Then
        MsgBox "Site des licences hors ligne veuillez essayer plus tard"
    Else
       ' MsgBox "Download unsuccessful: " & ErrorText
   End If

End Sub

 

[danval]

bonjour à tous,

ne cherchez plus j'ai trouvé la solution en creusant sur le net.

Bonne journée