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