comment renommer export txt en fonction d'une valeur de celluleRésolu

Question

Bonjour tout le monde, alors je me demandais comment modifier ce code pour lui dire de nommer mon .txt fraichement créé avec la valeur d'une cellule.
Cordialement.


Sub EcrireTxt()
Dim Fs As Object, A As Object
Dim i As Long
 
Set Fs = CreateObject("Scripting.FileSystemObject")
Set A = Fs.CreateTextFile("C:\Users\Public\Fichier Vide.txt", True)
With Sheets("kml")
   For i = 1 To .Cells(.Rows.Count, "A").End(xlUp).Row
      A.WriteLine (.Range("A" & i).Value)
   Next i
End With
A.Close
Set A = Nothing
Set Fs = Nothing
End Sub

bigfish_le vrai · Accepted Answer

Salut,

Concernant ta première question :

il existe une methhode propre au VBA, voici une fonction et un exemple de son utilisation:

Function FileRename(oldpathname As String, newpathname As String) As Byte
    FileRename = 0
    'on verifi que le fichier source existe et que le nouveau nom n'est pas déjà utilisé
    If Not Dir(oldpathname) "" And Dir(newpathname) "" Then
        On Error Resume Next
        Name oldpathname As newpathname
        If Error = 0 Then
            FileRename = 1
        Else 'si erreur
            FileRename = Err
            Err.Clear
        End If
        On Error GoTo 0
    End If
End Function

Sub test()
    Dim ReturnValue As Byte, AncienCheminNom As String, NouveauCheminNom As String
    Dim Msg As String
    AncienCheminNom = "C:\Temp\FichierTest.txt"
    NouveauCheminNom = "C:\Temp\NewFichierTest.txt"
    ReturnValue = FileRename(AncienCheminNom, NouveauCheminNom)
    If ReturnValue = 0 Then
        Msg = "Le fichier n'a pu être renommé !" & Chr(13) & Chr(13) & _
        "Veuillez vérifier que: " & Chr(13) & Chr(13) & _
        "Le fichier " & NouveauCheminNom & " existe !" & Chr(13) & _
        "ou que le fichier " & NouveauCheminNom & " n'existe pas déjà ! "
        MsgBox Msg, vbExclamation, "Erreur"
    Elseif ReturnValue > 1
        Msg = "L'erreur n° " & Str(Err.Number) & " a été générée par " _
         & Err.Source & Chr(13) & Err.Description
        MsgBox Msg, , "Erreur", Err.HelpFile, Err.HelpContext
    End If
End Sub

A+

cs_Jack · Answer

Salut

En supposant que :
- le nom du fichier se trouve dans A1 de la feuille "kml"
- le texte de cette cellule est compatible avec un nom de fichier
Alors
Set A = Fs.CreateTextFile(Sheets("kml").Range("A1").Text & ".txt", True)
Vala
Jack, MVP VB
NB : Je ne répondrai pas aux messages privés

Le savoir est la seule matière qui s'accroit quand on la partage (Socrate)

cs_Jack · Answer

Excuses, j'avais pas saisi que tu voulais renommer le fichier fraichement créé.
Puisque tu utilises FSO, le plus simple est de l'utiliser :
Après avoir fait le .Close de ton fichier, lance une copie avec .Copy, puis un .Delete de l'ancien fichier.
Prends soin de gérer les erreurs et/ou les options d'écrasement de fichiers.

r0man0 · Answer

Salut à toi jack,
excuses moi, je suis un rookie encore dans ce domaine, je ne saisie pas très bien ou tu veux en venir.
Merci

r0man0 · Answer

Bonjour,
J'ai trouvé une solution, en faite je renomme juste mon fichier texte créé précédemment, par contre je bloque sur autre chose, j'aimerai poser une condition si mon n est supérieur à 300 lignes alors il écrit les x premières lignes jusqu'à un mot précis puis les y lignes suivantes de mon mot précis jusqu'à la fin, par exemple un trajet le havre paris, ma première plage irait de la cellule havre à la cellule rouen et la seconde de la cellule rouen à la cellule paris, j'avais commencé quelque chose mais sans succès, je ne trouve pas la solution à mon problème, ça ne fonctionne pas, bon j'ai fait des erreurs mais j'avoue que mes yeux et mon esprit fatigue un peu, je post le code.


Sub FICELLERTE()

Dim Destination, MaPlage, PL, R, DEST As Range
Dim Fs, U As Object
Dim FIC, ErrMsg, mot, PA As String
Dim K As Long
Dim Result, Choices, DL As Integer


Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets("Work_Sheet_2").Select
Cells.ClearContents
Sheets("RTE_FLITESTAR").Select
Cells.ClearContents
Sheets("Compilation").Select
Set Destination = Sheets("Work_Sheet_2").Range("A1")
Set MaPlage = Sheets("Compilation").Range("A1:M" & Sheets("Compilation").Range("A65536").End(xlUp).Row)
Set tbl = ActiveCell.CurrentRegion


tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, tbl.Columns.Count).Select
MaPlage.Copy Destination

With Sheets("Work_Sheet_2")

    Range("N1").FormulaR1C1 = "1"

Cells.Find("*", after:=[A1], LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, searchdirection:=xlPrevious, _
    MatchCase:=False, SearchFormat:=False).Select

n = Selection.Row
mot = InputBox("Donnez code OACI")
DL = .Cells(Application.Rows.Count, 1).End(xlUp).Row
Set PL = .Range("T1:T" & DL)
Set R = PL.Find(mot, , xlValues, xlWhole)
End With

If Not R Is Nothing Then
PA = R.adress

With Sheets("RTE_FLITESTAR")
Set DEST IIf(.Cells(1, 1) "", .Cells(1, 1), .Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0))
End With

With Sheets("Work_Sheet_2")
        If n > 299 Then
MsgBox ("Dépassement de la capacité de traitement ROUTE (>300)")
For compteur = 1 To PA
.Range("T1:T" & compteur).Value.Copy DEST
Next compteur
        End If
        End With
        
For i = 1 To n
        Cells(i, 14).FormulaR1C1 = _
            "=R[-1]C+1"
        Cells(i, 15).FormulaR1C1 = _
            "=RC[-9]+((500*RC[-8]+3*RC[-7])/30000)"
        Cells(i, 17).FormulaR1C1 = _
            "=RC[-7]+((500*RC[-6]+3*RC[-5])/30000)"
        Cells(i, 16).FormulaR1C1 = _
            "=IF(RC[-11]=""s"",-RC[-1],RC[-1])"
        Cells(i, 18).FormulaR1C1 = _
            "=IF(RC[-9]=""W"",-RC[-1],RC[-1])"
        Cells(i, 20).FormulaR1C1 = _
            "=CONCATENATE(""W,  0,  "",C[-6],"",  "",C[-6],"","",C[-16],""            ,  "",C[-4],"",  "",C[-2],"",39154.4176025,  111, 4, 5,       255,  13158342,0, 0,    0"")"
Next i

    Range("T1:T65000").Copy

    Sheets("RTE_FLITESTAR").Columns("A:A").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

    Sheets("RTE_FLITESTAR").Select
For j = 1 To 5
        Rows("1:1").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Next j

    Range("A1").FormulaR1C1 = "OziExplorer Route File Version 1.0"
    Range("A2").FormulaR1C1 = "WGS 84"
    Range("A3").FormulaR1C1 = "Reserved 1"
    Range("A4").FormulaR1C1 = "Reserved 2"
    Range("A5").FormulaR1C1 = "R,  0,R0              ,,255"

Set Fs = CreateObject("Scripting.FileSystemObject")
Set U = Fs.CreateTextFile("\Etudes\public\03_MISSION\01_PREPARATION_MISSION\OUTIL ROUTE FLITESTAR\Route\RTE_FLITESTAR.rte", True)
    With Sheets("RTE_FLITESTAR")
For K = 1 To .Cells(.Rows.Count, "A").End(xlUp).Row
On Error GoTo Errorhandler
U.WriteLine (.Range("A" & K).Value)
Next K

Errorhandler:

      Select Case Err.Number

        Case 13:
            ErrMsg = "Une erreur est survenue ligne " & K - 5 & " de la feuille Compilation."

            Result = MsgBox(ErrMsg, Choices)

        If Result = vbOK Then
            Resume Next
        End If
        End Select
U.Close
Set U = Nothing
Set Fs = Nothing
    NOM = InputBox("Donnez un nom de fichier.wpt")
If NOM = "" Then
Exit Sub
Else
GoTo continu
End If
continu:
FIC = Dir("\Etudes\public\03_MISSION\01_PREPARATION_MISSION\OUTIL ROUTE FLITESTAR\Route\RTE_FLITESTAR.rte")
If FIC <> "" Then Name "\Etudes\public\03_MISSION\01_PREPARATION_MISSION\OUTIL ROUTE FLITESTAR\Route" _
& FIC As "\Etudes\public\03_MISSION\01_PREPARATION_MISSION\OUTIL ROUTE FLITESTAR\Route" & NOM & ".rte"
    End With
Sheets("Main_Sheet").Select
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox ("Export ROUTE réussi")
End If
End Sub


En faite, j'appel une fenêtre qui me demande de taper mon mot clé, elle le cherche, le trouve, l'identifie dans ma plage et lance une copie de la ligne 1 à la ligne contenant mon mot clé gràce à mon compteur vers ma feuille RTE_FLITESTAR, et pareil de la ligne de mon mot clé à la dernière ligne.
Bon ça commence à devenir laborieux pour moi, je sèche complètement.

r0man0 · Answer

Bonjour, je cherche toujours, je vais bien finir par trouver!

bigfish_le vrai · Answer

Re,

ah bah tien ! l&#8217;ami mortalino nous avais déjà posté un petit snippet sur le sujet ! 
A voir ici


A+

r0man0 · Answer

Bonjour, et bien merci pour tout, me conseillerez-vous de changer mon code, en m'inspirant de ce que vous m'avez donné, car pour l'instant je dois dire qu'il fonctionne en appelant l'inputbox, cependant si vous pensez qu'il serait judicieux de le modifier, je m'y attèle tout de suite, concernant mon autre soucis qq'un aurait une idée?

r0man0 · Answer

Bonjour, bigfish_le vrai et jack, alors que pensez-vous de mon code sinon, pour copier de la première ligne à "mot" et de "mot" à dernière ligne.

Comment renommer export txt en fonction d'une valeur de cellule

9 réponses

Votre réponse

Discussions similaires