macro création fichier + dossier

matt31

XLDnaute Occasionnel
Bonjour,

j'ai mis en place une macro qui me crée automatiquement des fichiers selon un modèle (macro Go) sachant qu'il me faut un fichier par semaine.
La macro en créant les fichiers les nomme de la même manière (le nom de l'EM en A1 et le n° de la semaine).

Je voudrais en plus de cela que la macro crée un dossier en fonction du nom de l'EM (cellule A1) et enregistre le fichiers créé à l'intérieur de ce dossier.
Actuellement, tous les fichiers sont créés dans un dossier 2013.

Merci par avance
 

Fichiers joints

BrunoM45

XLDnaute Barbatruc
Re : macro création fichier + dossier

Salut Matt31,

Voici le code à utiliser, j'ai supprimé les variables que tu n'utilisais pas (Wb et Ws)
VB:
Sub Go()
  ' Définir une variable pour le chemin
  Dim Chemin2 As String
  ' Définir une variable pour le nom du dossier
  Dim sDos As String
  ' Définir le chemin d'accès par défaut
  Chemin2 = "C:\Documents and Settings\PRAT.M\Mes documents\Fichier hebdo\2013\"
  'Chemin2 = ThisWorkbook.Path & "\"
  
  ' Récupérer le nom du dossier en cellule A1
  sDos = Sheets("Séjours à coder").Range("A1")
  
  ' Vérifier si ce dossier existe, grâce à l'instruction DIR()
  If Dir(Chemin2 & sDos, vbDirectory) = "" Then
    ' Dir ne renvoit rien, le dossier n'existe pas, il faut le Créer
    MkDir Chemin2 & sDos
  End If
  ' Vérifier si le dossier existe
  For Semaine = 1 To 52
    Cells(1, 9) = Semaine
    Equipe = Cells(1, 1).Value
    ' Empècher l'affichage d'alerte
    Application.DisplayAlerts = False
    fName2 = "EM " & Equipe & " - S " & Format(Semaine, "00") & ".xls"


    'Protection de la feuille
    Sheets("Séjours à coder").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
                      , AllowInsertingRows:=True, AllowDeletingRows:=True, AllowSorting:=True, _
                        AllowFiltering:=True, Password:="mdp@31"


    ActiveWorkbook.SaveAs Chemin2 & sDos & "\" & fName2
  Next Semaine
  ' Ré-activer les messages d'alerte
  Application.DisplayAlerts = True
End Sub
A+
 
Dernière édition:

matt31

XLDnaute Occasionnel
Re : macro création fichier + dossier

tout d'abord merci.
Cela crée bien un fichier portant le n° de l'EM (je rajouterai juste "EM " devant pour que cela corresponde exactement aux liens déjà créés) mais les fichiers ne s'enregistrent pas dans ce fichier créé et leur nommination n'est plus bonne. Dans l'exemple, ils s'appellent désormais "68EM 68 - S (n° de la semaine).xls" au lieu de "EM 68 - S (n° de la semaine).xls"
 

BrunoM45

XLDnaute Barbatruc
Re : macro création fichier + dossier

Re,

Oups, petite omission de ma part :eek:

Ligne à remplacer par
Code:
ActiveWorkbook.SaveAs Chemin2 & sDos & "\" & fName2
Car Chemin2 = "C:\Documents and Settings\PRAT.M\Mes documents\Fichier hebdo\2013\"
sDos = "68" et fname2 = "EM 68 - S (n° de la semaine).xls"

Donc si tu ne mets pas le "\" à la fin, ça te donne
Code:
ActiveWorkbook.SaveAs "C:\Documents and Settings\PRAT.M\Mes documents\Fichier hebdo\2013\68EM 68 - S (n° de la semaine).xls"
A+
 
Dernière édition:

Taebo

XLDnaute Nouveau
Re : macro création fichier + dossier

Je profite de vous dire merci aussi, puisque j'ai pas mal utilisé votre code.
 

BrunoM45

XLDnaute Barbatruc
Re : macro création fichier + dossier

Bonjour Taebo et merci pour ce retour ;)

Un remerciement ne coûte rien, mais apporte tellement :D

Bonne journée et au plaisir de l'entraide et du partage
 

Discussions similaires


Haut Bas