Modification code

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

Re bonjour,

bon je viens de faire plusieurs essais mais quand je touche au code plus rien ne fonctionne. grrrrrrrrrrrrr

alors j'ai vraiment besoin des expert VBA de ce forum.

Daniel

danval, le forum,

Sans fichier ni source pour tester

Je ne suis pas une experte, mais si tu remplaces : "NTC-OK.txt" par Range("ND_NomFich"), ND_NomFich étant ton champ nommé qui contient le texte NTC-OK.txt, tu devrais faire un bout.

Le champ nommé pour le classeur et non pour la feuille; sinon, il faudra ajouter le nom de la feuille,

tel : Worksheets("ADMIN").Range("ND_NomFich")

LaCéline

merci je regarde demain

Bonsoir,

Tu peux utiliser un InputBox pour demander le nom du fichier :

Sub LireFichierTXT()

    Dim i As Long
    Dim xRepertoire As String
    Dim xNomFichier As String
    Dim Lig As Long
    Dim xNumSerie As String
    Dim xAdrMail As String
    Dim WS As Worksheet

    xNomFichier = InputBox("Nom du fichier ?", , "Défaut.txt")
    If xNomFichier = "" Then Exit Sub

    If Right(xNomFichier, 4) <> ".txt" Then xNomFichier = xNomFichier & ".txt"

    ' xRepertoire = Workbooks(ActiveWorkbook.Name).Path & ":"   'Doit terminer avec un ":"  pour mac
    xRepertoire = Workbooks(ActiveWorkbook.Name).Path & "\"    'Doit terminer avec un "\" pour PC

    Set WS = Sheets("ADMIN")                 'Feuille où _crire les r_sultats

   'Ouvrir le fichier
    Open xRepertoire & xNomFichier For Input As #1

        'Lecture du fichier et écriture dans Excel
        Lig = 16

        Do Until EOF(1)

            Input #1, xNumSerie, xAdrMail
            WS.Cells(Lig, "G") = xNumSerie
            WS.Cells(Lig, "H") = xAdrMail
            Lig = Lig + 1

        Loop

    Close #1

End Sub

Function TestPCAutoris_()
    '----------------------------------------------------------
   '                    Test si fichier ouvert sur PC autoris_
   '----------------------------------------------------------

    Dim FichierASupprimer As String
    Dim xNomFichier As String

    TE_L1 = Worksheets("ADMIN").Range("L2").Value
    TE_L3 = Worksheets("ADMIN").Range("L4").Value

    xNomFichier = InputBox("Nom du fichier ?", , "Défaut.txt")
    If xNomFichier = "" Then Exit Function

    If Right(xNomFichier, 4) <> ".txt" Then xNomFichier = xNomFichier & ".txt"

    LocalFileName = Workbooks(ActiveWorkbook.Name).Path & "\" & xNomFichier
   ' 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 & "\" & xNomFichier

    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
    Dim xNomFichier As String

    xNomFichier = InputBox("Nom du fichier ?", , "Défaut.txt")
    If xNomFichier = "" Then Exit Function

    If Right(xNomFichier, 4) <> ".txt" Then xNomFichier = xNomFichier & ".txt"

    URL = "http://monsite.eu/Licences/" & xNomFichier
    LocalFileName = Workbooks(ActiveWorkbook.Name).Path & "\" & xNomFichier
    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

Il y a juste la fonction qui me chagrine, elle n'est pas sensée exécuter toutes ces actions mais juste effectuer des calculs et retourner une ou des valeurs mais bon, c'est toi qui vois !

bonjour,

merci pour ce travail.

mais juste une chose à chaque fois que l'on doit se servir du nom il y as un inputbox.

alors le but est d'utiliser une cellule qui contient le nom du fichier pour tout le code.

le cellule est dans la feuille ADMIN qui est masquée pour monsieur tout le monde.

comme cela quand je crée un nouveau fichier j'ai juste à changer le nom du fichier dans admin et plus rien d'autre à faire.

Merci

Daniel

re,

Bon j'ai adapté la solution en supprimant les input et cela marche.

un grand merci.

Daniel

Rechercher des sujets similaires à "modification code"