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
 

Pièces jointes

  • fichier hebdo.xls
    138 KB · Affichages: 64
  • fichier hebdo.xls
    138 KB · Affichages: 85
  • fichier hebdo.xls
    138 KB · Affichages: 72
C

Compte Supprimé 979

Guest
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 modification par un modérateur:

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"
 
C

Compte Supprimé 979

Guest
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 modification par un modérateur:

Discussions similaires

Statistiques des forums

Discussions
311 734
Messages
2 082 020
Membres
101 872
dernier inscrit
Colin T