Excel VBA Export multi onglet txt.file

[enzo_s]

Bonjour à tous,
Je suis nouveau sur le forum et je fais mes première macro en VBA 🙂 mais je sèche déjà

Je cherche à faire une macro qui check la cellule "B3" (yes ou No) et qui export dans un fichier TXT
B3= No --> export uniquement l'onglet P-Router1
B3= Yes --> export l'onglet P-Router1et P-router2 dans deux fichier TXT séparé avec comme nom de ficher le nom des onglets

Je joins un fichier comme exemple

Merci de votre aide 🙂

Enzo

 

[vgendron]

Hello

Dans ton fichier, il n'y a aucune macro...?

 

[enzo_s]

Effectivement, je cherche à la crée depuis le debut

 

[vgendron]

donc dans ce cas

Sub Macro1()

'
Application.ScreenUpdating = False
With Sheets("Basic") 'on récupère le YES ou NO
    FullMesh = UCase(.Range("B3"))
End With
repertoire = ActiveWorkbook.Path 'on récupère le répertoire actif
Application.DisplayAlerts = False 'on évite les alertes

With Sheets("P-Router1") 'on copie la feuille
    .Copy
End With
ActiveWorkbook.SaveAs Filename:=repertoire & "\P-Router1.txt", FileFormat:=xlTextMSDOS, CreateBackup:=False 'on enregistre au format TXT
ActiveWindow.Close 'on ferme
      
If FullMesh = "YES" Then 'si YES, on fait la meme chose avec le deuxième onglet
    With Sheets("P-Router2")
        .Copy
    End With
  
    ActiveWorkbook.SaveAs Filename:=repertoire & "\P-Router2.txt", FileFormat:=xlTextMSDOS, CreateBackup:=False
    ActiveWindow.Close
End If
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

 

[enzo_s]

WHAOO 😱

Génial pas de mot !! Merci !!

Pour améliorer puis je décider du répertoire ou le sauvegarder ?

 

[enzo_s]

Encore une question, comment récupérer un nom qui ce trouve dans par exemple "F18" et l'utiliser dans le nom du ficher :
Exemple :
F18 = NCHBSGRUSW01
F19 = NCHBSGRUSW02
FullMesh : "B3"= Yes
Les noms de fichier devrait être NCHBSGRUSW01-P-Router1.txt et NCHBSGRUSW02-P-Router2.txt

Merci !!!

 

[ThomasR]

Bonjour,

pour commencer je te conseil de déclarer les variables utilisés dans l'exemple donné

dim FullMesh as string, repertoire as string

Concernant ta demande de préfixer le nom du fichier avec la valeur de la cellule F18 je remplacerais cette ligne

repertoire = ActiveWorkbook.Path 'on récupère le répertoire actif
repertoire = ActiveWorkbook.Path & "\" & cells(18,"F").value

Je sais que le nom de ta variable ne veut plus rien dire car ce n'est plus un répertoire, alors renomme la si tu veux.
si tu veux garder la cohérence et y mettre un répertoire. dans ce cas il faudra créer une nouvelle variable exemple

dim prefixName as string
prefixName = ranges("F18").value

et au moment de l'enregistrement faire ceci

 ActiveWorkbook.SaveAs Filename:=repertoire & "\" & prefixName & "P-Router2.txt", FileFormat:=xlTextMSDOS, CreateBackup:=False

et ceux deux fois donc plus de ligne de code pour le même résultat (pense à la planète lol)

Cordialement,
Thomas

 

[ThomasR]

ah et concernant le répertoire, si c'est toujours le même endroit tu peux le saisir dans le code car là dans l'exemple il le fait dans le dossier du fichier excel mais tu peux saisir directement un truc du genre

repertoire="C:/toto"

si tu souhaites ouvrir une fenêtre de sélection du folder alors il faut faire ceci dans une fonction

Function GetFolder() As String
    Dim fldr As FileDialog
    Dim sItem As String
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        .InitialFileName = Application.DefaultFilePath
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With
NextCode:
    GetFolder = sItem
    Set fldr = Nothing
End Function

et l'utiliser comme ceci

repertoire= GetFolder

et si je fais le lien avec mon poste précédent

repertoire = GetFolder & "/" & ranges("F18").value

 

[enzo_s]

Bonjour Thomas,
J'ai ajouter les les lignes ne ça ne fonctionne pas, j'ai du mal faire quelque chose.
J'ai joins le ficher avec la macro
Merci de votre aide

 

[vgendron]

Hello

la syntaxe pour le répertoire n'est pas bonne
ce que j'avais donné était ok

Sub Macro1()

'
Dim FullMesh As String, repertoire As String
Dim prefixName As String

prefixName = Range("F18").Value
Application.ScreenUpdating = False

With Sheets("Basic") 'on récupère le YES ou NO
    FullMesh = UCase(.Range("B3"))
End With

repertoire = ActiveWorkbook.Path 'on récupère le répertoire actif
Application.DisplayAlerts = False 'on évite les alertes

With Sheets("P-Router1") 'on copie la feuille
    .Copy
End With
'ActiveWorkbook.SaveAs Filename:=repertoire & "\P-Router1.txt", FileFormat:=xlTextMSDOS, CreateBackup:=False 'on enregistre au format TXT
ActiveWorkbook.SaveAs Filename:=repertoire & "\" & prefixName & "P-Router2.txt", FileFormat:=xlTextMSDOS, CreateBackup:=False
ActiveWindow.Close 'on ferme
      
If FullMesh = "YES" Then 'si YES, on fait la meme chose avec le deuxième onglet
prefixName = Range("F19").Value

    With Sheets("P-Router2")
        .Copy
    End With
  
    ActiveWorkbook.SaveAs Filename:=repertoire & "\P-Router2.txt", FileFormat:=xlTextMSDOS, CreateBackup:=False
    ActiveWindow.Close
End If
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

 

[enzo_s]

Ok ça fonctionne merci mais ci je souhaite choisir le dossier ou je veux sauvegarder je dois ajouter :

Function GetFolder() As String
Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Select a Folder"
.AllowMultiSelect = False
.InitialFileName = Application.DefaultFilePath
If .Show <> -1 Then GoTo NextCode
sItem = .SelectedItems(1)
End With
NextCode:
GetFolder = sItem
Set fldr = Nothing
End Function

 

[vgendron]

voici le code complet

Public repertoire As String
Sub Macro1()
Application.ScreenUpdating = False
'
Dim FullMesh As String
Dim prefixName As String

'1) Demander le répertoire de sauvegarde
Choix = MsgBox("le répertoire actif est: " & ActiveWorkbook.Path & Chr(10) & "Souhaitez vous le changer?", vbYesNo)
If Choix = vbYes Then
     ChangerRepertoire
Else
    repertoire = ActiveWorkbook.Path
End If
'MsgBox repertoire

'2) on récupère le nom du premier fichier en F18
prefixName = Range("F18").Value

With Sheets("Basic") 'on récupère le YES ou NO
    FullMesh = UCase(.Range("B3"))
End With

Application.DisplayAlerts = False 'on évite les alertes

With Sheets("P-Router1") 'on copie la feuille
    .Copy
End With
ActiveWorkbook.SaveAs Filename:=repertoire & prefixName & "-P-Router1.txt", FileFormat:=xlTextMSDOS, CreateBackup:=False
ActiveWindow.Close 'on ferme
    
If FullMesh = "YES" Then 'si YES, on fait la meme chose avec le deuxième onglet
    prefixName = Range("F19").Value
    With Sheets("P-Router2")
        .Copy
    End With

    ActiveWorkbook.SaveAs Filename:=repertoire & prefixName & "-P-Router2.txt", FileFormat:=xlTextMSDOS, CreateBackup:=False
    ActiveWindow.Close
End If
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub


Sub ChangerRepertoire()
Set NewRep = Application.FileDialog(msoFileDialogFolderPicker)
NewRep.Show
If NewRep.SelectedItems.Count > 0 Then
    repertoire = NewRep.SelectedItems(1) & "\"
    ChDir repertoire
Else
    MsgBox "Aucun Répertoire Sélectionné"
End If
End Sub

PS: dans le nom du fichier, il ne DOIT PAS y avoir de "/"

 

[enzo_s]

Merci Vgendron on peut enlever la boite de dialogue et aller directement à la fenêtre save ?

 

[vgendron]

oui, il suffit d'enlever les lignes

'1) Demander le répertoire de sauvegarde
Choix = MsgBox("le répertoire actif est: " & ActiveWorkbook.Path & Chr(10) & "Souhaitez vous le changer?", vbYesNo)
If Choix = vbYes Then
     ChangerRepertoire
Else
    repertoire = ActiveWorkbook.Path
End If
'MsgBox repertoire

et remplacer par uniquement

     ChangerRepertoire

 

[enzo_s]

Nickel tout fonctionne !! Mille merci