Discussion :

[Muzzik]

Bonjour aux forumeurs,

Avec le concours de plusieurs post, après plusieurs tentatives vaines je n'arrive pas a finaliser correctement ma macro.
Mon souhait serait qu'a l’exécution de celle ci je puisse avoir la fenêtre de dialogue (Enregistrer sous) qui apparaisse avec mon chemin de destination. mais que soit valide et apparaisse le nom de mon fichier contenu dans ma cellule B10.
Jusque la cela semble simple mais je n'y arrive pas.
Dans la macro ci dessous l'enregistrement ce fait bien mais pas en validant avec le nom, simplement en cliquant sur la croix....!!

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
Sub Sauve()
'
' Sauve Macro
 
   Range("B9").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A17").Select
    ActiveWindow.SmallScroll Down:=18
    Range("A17:E156").Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Sheets(Array("Provision", "Taux", "Stock-Chine", "GPL-HP", "glemea-1")).Select
    Sheets("GPL-HP").Activate
    ActiveWindow.SelectedSheets.Delete
    Columns("C:H").Select
    Selection.EntireColumn.Hidden = True
    Columns("J:K").Select
    Selection.EntireColumn.Hidden = True
    Columns("P:P").Select
    Selection.EntireColumn.Hidden = True
    Columns("S:S").Select
    Selection.EntireColumn.Hidden = True
    With Application.FileDialog(2)
  Range("B10").Select
    ActiveWorkbook.saveas Filename:=[B10].Value & ".xlsm"
        .InitialFileName = Nom
        .Show
         On Error Resume Next 'si annulé
        Chemin = .SelectedItems(1)
     End With
     If Err.Number = 0 Then
       ActiveWorkbook.saveas Filename:=Destination & [B10].Value & ".xlsm"
     End If
    ActiveSheet.Shapes.Range(Array("Button 4")).Select
    Selection.Delete
    ActiveSheet.Shapes.Range(Array("Button 5")).Select
    Selection.Delete
End Sub

Si quelqu'un pouvait m'accompagner et m'expliquer ce serait sympa
Merci a vous

[Theze]

Bonjour,

Teste pour voir si ça convient :

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
 
Sub Sauve()
 
    Dim Nom As String
    Dim Chemin As String
 
    'ne garde que le résultat de la fonction
    Range("B9").Value = Range("B9").Value
 
    Range("A17:E156").Value = Range("A17:E156").Value
 
    Sheets(Array("Provision", "Taux", "Stock-Chine", "GPL-HP", "glemea-1")).Delete
 
    Range("C:H,J:K,P:P,S:S").EntireColumn.Hidden = True
 
    Nom = Range("B10").Value & ".xlsm"
 
    With Application.FileDialog(2)
 
        .InitialFileName = Nom
        .Show
 
        On Error Resume Next 'si annulé
        Chemin = .SelectedItems(1)
 
    End With
 
    If Err.Number = 0 Then ActiveWorkbook.SaveAs Chemin & Nom Else Exit Sub
 
    ActiveSheet.Shapes.Range("Button 4").Delete
    ActiveSheet.Shapes.Range("Button 5").Delete
 
End Sub

[Muzzik]

Bonjour Theze,

Merci d'avoir pris le temps de regarder mon problème et d'y avoir apporté des corrections.
Cela fonctionne bien comme je le désire sauf que lors de l'enregistrement il me nomme mon fichier 2 fois comme ceci "CLS-CFA_20150909-Test-XX0001.xlsxCLS-CFA_20150909-Test-XX0001"
Je ne suis pas suffisamment caler pour modifier ton code....

Sinon pour le reste c'est génial,

Merci de ton retour

[Theze]

Oups,

Mais oui, j'ai concaténé le nom du fichier au moment de l'enregistrement, voici le code rectifié :

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
 
Sub Sauve()
 
    Dim Nom As String
    Dim Chemin As String
 
    'ne garde que le résultat de la fonction
    Range("B9").Value = Range("B9").Value
 
    Range("A17:E156").Value = Range("A17:E156").Value
 
    Sheets(Array("Provision", "Taux", "Stock-Chine", "GPL-HP", "glemea-1")).Delete
 
    Range("C:H,J:K,P:P,S:S").EntireColumn.Hidden = True
 
    Nom = Range("B10").Value & ".xlsm"
 
    With Application.FileDialog(2)
 
        .InitialFileName = Nom
        .Show
 
        On Error Resume Next 'si annulé
        Chemin = .SelectedItems(1)
 
    End With
 
    If Err.Number = 0 Then ActiveWorkbook.SaveAs Chemin Else Exit Sub
 
    ActiveSheet.Shapes.Range("Button 4").Delete
    ActiveSheet.Shapes.Range("Button 5").Delete
 
End Sub

[Muzzik]

Merci theze, mais il me semble que tu me renvois le même code

[aziz1015]

Bonjour,

Theze avait fait l'erreur à la ligne 28 qu'il a changé dans le second code, la ligne 28 du premier code :

Code :

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

If Err.Number = 0 Then ActiveWorkbook.SaveAs Chemin & Nom Else Exit Sub

a été changé comme cela dans le deuxième code :

Code :

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

    If Err.Number = 0 Then ActiveWorkbook.SaveAs Chemin Else Exit Sub

As tu au moins essayé de compiler ?

Cordialement