Bonjour à tous,
Tout d'abord je tiens à remercier tous les intervenants sur ce forum qui m'a beaucoup aider et dans lequel j'ai toujours pu trouver des astuces.
Je ne suis pas très fort en VBA mais j'arrive assai régulièrement à modifier des codes trouvé sur la toile pour réaliser mon travail.
Je continue a apprendre lentement.
Voici mon problème:
J'ai créé un fichier pour les plannings de mon personnel, je l'ai édite tous par une macro avec le nom de chaque employé.
Cela fonctionne très bien mais il me faut ranger tout ces fichiers dans des dossiers et j'aimerais le faire automatiquement.
A l'heure actuelle sur la page "Employés" lorsque j'appuie sur le bouton Générer tous les calendriers, il me crée un dossier avec comme nom l'année et il me mets tous les fichiers dedans avec le nom qui se trouve dans la colonne H
Je voudrais que sur le bouton "Générer par services" il me crée également tous les sous dossier se trouvant dans la colonne G "Services" et qu'il fasse le tri automatiquement
Autre problème que je rencontre l'affichage des boutons ne se fait pas correctement à l'ouverture du fichier, je suis obligé de faire un clic droit dessus
le fichier :V_15.8 - test dossier - Copie.xlsm
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57 Private Sub CommandButton1_Click() Dim Fe As Worksheet With ListObjects(1).Range 'tableau structuré Dim chemin$, dossier$, fichier$, i& chemin = ThisWorkbook.Path & "\" dossier = chemin & "Planning news\" If Dir(dossier, vbDirectory) = "" Then MkDir dossier 'création du dossier '---suppression des fichiers--- fichier = Dir(dossier & "*.xlsm") On Error Resume Next While fichier <> "" Workbooks(fichier).Close False 'si l'un des fichiers est ouvert on le ferme Kill dossier & fichier fichier = Dir Wend On Error GoTo 0 '---création des fichiers .xlsm--- Application.DisplayAlerts = False fichier = ThisWorkbook.FullName 'mémorise For i = 2 To .Rows.Count '---Copie des matricules dans les enregistrements de fichiers--- Sheets("Calendrier").Range("B5") = .Cells(i, 1) '---Vérrouillage fichier à sauvegarder--- Sheets("Log changements").Range("C2").Value = "Verrouillage Actif" Sheets("Log changements").Range("C2").Font.ColorIndex = 3 For Each Fe In Sheets 'If Fe.Name = "Log changements" And Fe.Name = "Calendrier" Then Fe.Protect "letalcestblanc" If Fe.Name <> "Log changements" And Fe.Name <> "Calendrier" Then Fe.Visible = False Next Fe Sheets("Log changements").Protect "letalcestblanc" Sheets("Calendrier").Activate Sheets("Calendrier").Protect "letalcestblanc" ActiveWorkbook.Protect "letalcestblanc" '---Copie du fichier avec nom--- If .Cells(i, 7) <> "" Then ThisWorkbook.SaveAs dossier & .Cells(i, 7) & " " & Range("K1") & ".xlsm", 52 'fichier .xlsm '---Deprotection fichier actif--- ActiveWorkbook.Unprotect "letalcestblanc" For Each fc In Worksheets fc.Visible = xlSheetVisible fc.Unprotect "letalcestblanc" Next Sheets("Log changements").Range("C2").Value = "Verrouillage Inactif" Sheets("Log changements").Range("C2").Font.ColorIndex = 4 Sheets("Log changements").Activate Next End With ThisWorkbook.SaveAs fichier, 52 'fichier .xlsm End Sub
Partager