Discussion :

[miliev83]

Bonjour,

J'essaye de mettre en place une macro qui me permet:
- faire une copie d'une feuille de mon classeur vers un autre
- d'ouvrir la fenêtre enregistrer sous ayant le nom du fichier pré-rempli avec le N°Sem et date

Je rencontre 2 soucis et 2 questions :
1. J'aimerai que le chemin d'accès soit par défaut exemple :
C:\Users\ADM\Desktop\

Le but est que l'utilisateur puisse à partir de ce chemin choisir le dossier qu'il souhaite selon la date du fichier.
Exemple : Si S26 mercredi 26-06 il ira l'enregistrer dans le dossier S26.

2. Lorsque je lance la macro et que j'enregistre dans un dossier le fichier ne s'enregistre pas.

Questions :
- Est il possible de mettre un code permettant de selon le N° de semaine du fichier venir enregistrer automatiquement dans le dossier correspondant au N° de semaine ?

- Lors de la copie il me copie également les boutons des macros, est il possible d'éviter cela ?

Voici ce que j'ai pu faire en fouillant les forum :

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
Sub Macro1()
'
' Macro1 Macro
 
' test Macro
LePath = ThisWorkbook.Path
Dim nom As String
    Dim Jour As String
    Dim Chemin
    Dim NumSem As String
    Sheets("Planning2").Select
    ActiveSheet.Buttons.Add(1141.5, 89.25, 132, 30.75).Select
    ActiveSheet.Buttons.Add(1140.75, 51.75, 132.75, 28.5).Select
    ActiveSheet.Buttons.Add(1140.75, 8.25, 132.75, 32.25).Select
    Sheets("Planning2").Copy
    NumSem = Format(Now, "ww dddd dd-mm")
    LePath = ThisWorkbook.Path
 
    nom = NumSem & ".xls"
    With Application.FileDialog(2)
 
        .InitialFileName = Lepatch & "S" & nom & ".xls"
        .Show
        End With
 
End Sub

Merci à vous!!

[mercatog]

Une partie de la réponse (avec des questions)

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
Sub Macro1()
Dim LePath As String, RepSem As String
 
LePath = ThisWorkbook.Path
'On crée à chaque fois des boutons???
With Worksheets("Planning2")
    .Buttons.Add 1141.5, 89.25, 132, 30.75
    .Buttons.Add 1140.75, 51.75, 132.75, 28.5
    .Buttons.Add 1140.75, 8.25, 132.75, 32.25
    .Copy
End With
 
RepSem = "S" & DatePart("ww", Date)
 
'Création du répertoir de la semaine s'il n'existe pas
If Dir(LePath & "\" & RepSem, vbDirectory) = "" Then MkDir LePath & "\" & RepSem
 
'On enregistre le classeur
With ActiveWorkbook
    Application.DisplayAlerts = False
    .SaveAs LePath & "\" & RepSem & "\" & Format(Now, "ww dddd dd-mm") & ".xls"
    Application.DisplayAlerts = False
    .Close
End With
End Sub

[miliev83]

Bonjour,

Merci pour ta réponse, alors lorsque je l'ai lancé pour la première fois cela a fonctionner c'est a dire que cela m'a créer le dossier et enregistrer le fichier.
Mais lorsque j'ai voulu la relancer, cela me met "erreur d'exécution 1004" document non enregistré.

et j'ai cette ligne qui est surligné en jaune

.SaveAs LePath & "\" & RepSem & "\" & Format(Now, "ww dddd dd-mm") & ".xls"

Pour ton commentaire :

On crée à chaque fois des boutons???

Tu fais référence au bouton de la macro ? si c'est ça, je souhaite que les boutons ne soit pas copier si c'est possible.

[mercatog]

Origine de l'erreur 1004
Ton fichier ainsi créé n'était-il pas ouvert quand tu as lancé la macro une seconde fois?

[miliev83]

Bonjour,

Il me semble oui

vois tu comment faire du coup ??

[miliev83]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Sub Macro1()
 
' test Macro
    ActiveSheet.Copy
    On Error Resume Next
Application.Dialogs(xlDialogSaveAs).Show Format([I4], "dddd dd-mm")
Application.DisplayAlerts = True
End Sub

le format date de ma cellule I4 est dddd dd/mm/aaaa

le problème c'est que pour enregistre le fichier les / sont interdit, comment faire pour que cela enregistre au format dddd dd-mm car cela ne me le prend pas en compte

[Docmarti]

Il suffit de remplacer tous les caractères interdits par Windows dans le nom des fichiers :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Function traiteNomFic(nomFic)
 carInterdits = "/\:*?<>|" & Chr(34)
 For i = 1 To Len(nomFic)
  If InStr(carInterdits, Mid(nomFic, i, 1)) > 0 Then
     Mid(nomFic, i, 1) = "-"
    End If
 Next
 traiteNomFic = nomFic
End Function

[miliev83]

merci