Excel VBA Export multi onglet txt.file

enzo_s

XLDnaute Junior
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
 

Pièces jointes

  • Book1.xlsm
    12.6 KB · Affichages: 4

vgendron

XLDnaute Barbatruc
donc dans ce cas

VB:
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

XLDnaute Junior
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

XLDnaute Occasionnel
Bonjour,

pour commencer je te conseil de déclarer les variables utilisés dans l'exemple donné
VB:
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
Code:
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
Code:
dim prefixName as string
prefixName = ranges("F18").value
et au moment de l'enregistrement faire ceci
Code:
 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

XLDnaute Occasionnel
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
Code:
repertoire="C:/toto"

si tu souhaites ouvrir une fenêtre de sélection du folder alors il faut faire ceci dans une fonction
Code:
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
Code:
repertoire= GetFolder

et si je fais le lien avec mon poste précédent
Code:
repertoire = GetFolder & "/" & ranges("F18").value
 

vgendron

XLDnaute Barbatruc
Hello

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

VB:
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

XLDnaute Junior
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

XLDnaute Barbatruc
voici le code complet
VB:
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 "/"
 

vgendron

XLDnaute Barbatruc
oui, il suffit d'enlever les lignes
VB:
'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
VB:
     ChangerRepertoire
 

Discussions similaires

Réponses
7
Affichages
292
Réponses
12
Affichages
217