Discussion :

[EditeClean]

Bonjour à tous, je viens à vous pour vous demander votre aide
Cela semble facile pour certain et il y a pas mal de forum qui en parle mais après avoir tout essayé, je me tourne vers vous

Le but est d'avoir un bouton (Déja installer et prêt a foncitonner ) qui va tout d’abord "enregistrer sous" dans le même dossier que le fichier de base, avec un nom de fichier personnalisé, dans mon cas : "Olivier" & [C3] & ".xlsm". Celui ci se fera sans que l'utilisateur s'en rende compte. En même temps, je voudrais que le bouton soit supprimer sur la copie et non sur le document de base.

Je voudrais que tout le classeur soit enregistrer, et non seulement la première page.

Voici mon code :

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
Sub Enregistrer_sous()
Dim FileD As FileDialog
Dim chemin As String, fichier As String
 
Set FileD = Application.FileDialog(msoFileDialogSaveAs)
 
If FileD.Show = True Then
 
chemin = ThisWorkbook.Path
 
fichier = "Olivier" & [C3] & ".xlsm"
 
ActiveWorkbook.SaveCopyAs Filename:=fichier
 
End If
 
End Sub

- Ce code m'affiche la boite de dialogue sans nom de fichier , Mais une fois un nom de fichier indiqué, et enregistrer, la macro de mon bouton continue sur sur chemin à exécuter la deuxième requête, toujours dans le document de base "OlivierHeuresSup.xlsm", il passera a l'année prochaine


Un grand merci

[thebenoit59]

Bonsoir EditeClean.

La boîte de dialogue est appelée dans ton code, donc c'est normal qu'il l'affiche.
Pour ce qui est du code :

Code :

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

1
2
3
4
5
6
Sub Enregistrer_sous()
Dim chemin As String, fichier As String
chemin = ThisWorkbook.Path & Application.PathSeparator
fichier = "Olivier" & Sheets("RECAP").[C3] & ".xlsm"
ActiveWorkbook.SaveCopyAs Filename:=chemin & fichier
End Sub

[kiki29]

Salut, il serait sage de vérifier la validité du nom du fichier via qqch comme :

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
Option Explicit
 
Private Function NomFichierValide(sChaine As String) As Boolean
Dim i As Long
Const CaracInterdits As String = """*/:<>?[\]|"
    NomFichierValide = True
    If Len(sChaine) = 0 Then
        NomFichierValide = False
        Exit Function
    End If
    For i = 1 To Len(CaracInterdits)
        If InStr(sChaine, Mid$(CaracInterdits, i, 1)) > 0 Then
            NomFichierValide = False
            Exit Function
        End If
    Next i
End Function 
 
Sub Tst()
Dim sFichier As String
    sFichier = "Olivier" & Sheets("RECAP").[C3] & ".xlsm"
    If NomFichierValide(sFichier) Then
        ' sauvegarde
    Else
        With Sheets("RECAP")
            .Activate
            .Range("C3").Select
        End With
        MsgBox "Nom de fichier invalide", vbOKOnly + vbInformation
    End If
End Sub

[EditeClean]

Bonjour et merci pour votre aide, je vais essayer ça tout de suite

Cependant j'ai oublier de préciser quelque chose, sur le nouveau classeur enregistrer, est ce possible de supprimer le bouton sur la feuil1?

Un grand merci

[kiki29]

Salut, à adapter à ton contexte

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
Option Explicit
 
Sub Enregistrer_sous()
Dim sChemin As String, sFichier As String
Dim wkb As Workbook
    Application.ScreenUpdating = False
    sChemin = ThisWorkbook.Path & "\"
    sFichier = "Olivier" & Feuil1.Range("C3") & ".xlsm"
 
    If NomFichierValide(sFichier) Then
        ActiveWorkbook.SaveCopyAs Filename:=sChemin & sFichier
 
        Set wkb = Workbooks.Open(sChemin & sFichier)
        SuppShapes wkb
        Application.DisplayAlerts = False
        wkb.SaveAs Filename:=sChemin & sFichier
        wkb.Close
        Set wkb = Nothing
        With Application
            .DisplayAlerts = True
            .ScreenUpdating = True
        End With
    Else
        With Feuil1
            .Activate
            .Range("C3").Select
        End With
        MsgBox "Nom de fichier invalide", vbOKOnly + vbInformation
    End If
End Sub
 
Private Function NomFichierValide(sChaine As String) As Boolean
Dim i As Long
Const CaracInterdits As String = """*/:<>?[\]|"
    NomFichierValide = True
    If Len(sChaine) = 0 Then
        NomFichierValide = False
        Exit Function
    End If
    For i = 1 To Len(CaracInterdits)
        If InStr(sChaine, Mid$(CaracInterdits, i, 1)) > 0 Then
            NomFichierValide = False
            Exit Function
        End If
    Next i
End Function
 
Private Sub SuppShapes(Wk As Workbook)
Dim Obj As OLEObject
    For Each Obj In Wk.ActiveSheet.OLEObjects
        If TypeOf Obj.Object Is MSForms.CommandButton Then Obj.Delete
    Next Obj
End Sub

Après il y a : Visual Basic Editor qui peut te permettre d'enregistrer le classeur et de supprimer la totalité des procédures.

[EditeClean]

Kiki ça fonctionne NICKEL Un Grand merci encore pour vos réponses, j'adore ce forum et tout ce qu'on peu y trouver