Discussion :

[Tomtomtvn]

Bonjour à tous,

j'ai cherché un peu sur ce forum et je n'arrive pas à adapter comme je le voudrais le code que j'ai trouvé.

Actuellement j'ai un gros fichier excel avec beaucoup de feuilles dont une qui sert de base de donnée et une autre qui va générer une fiche de transport.
Je souhaiterai enregistrer cette fiche de transport dans un nouveau classeur qui ne soit plus lié au classeur initial.
Pour cela je copie la feuille dans un nouveau classeur sélectionne la zone et colle les valeur uniquement sur la même zone. Enfin je supprime le bouton qui me sert à enregistrer la feuille dans le nouveau classeur.

Ensuite c'est là que ça se corse : je veut sauvegarder le nouveau classeur.
J'ai créé un code qui fonctionne sous excel 2003 mais pas sous 2010 car même si la fenètre de dialogue s'ouvre le nom par défaut déjà incrémenté n'apparait pas dans la case et je n'ai aucun type de fichier associé.

Voici le 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
18
19
20
21
22
23
24
25
26
27
28
29
30
31
 
Sub EnregFicheTrans()
 
    Sheets("Fiche transport").Select 'sélectionne la feuille fiche de transport
    Sheets("Fiche transport").Copy 'copie la feuille dans un nouveau classeur
    Range("A1:H47").Select 'sélectionne la zone de la fiche dans le nouveau classeur
    Selection.Copy 'copie la zone du nouveau classeur dans le presse-papier
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 'colle les valeurs uniquement dans le nouveau classeur
 
    ActiveSheet.Shapes.Range(Array("Button 1")).Select
    Selection.Delete
 
Dim addrfeuisauv As String
 
addrfeuisauv = "C:\" 'Chemin sauvegarde
 
Do
chaine$ = "Camion N°" & Index + 1 & ".xls"
myfile = Dir(addrfeuisauv & chaine$) 'existe t il déja?
    If myfile <> "" Then Index = Index + 1 'si oui, incrémenter index
        If myfile = "" Then Exit Do   'si le fichier n'existe pas, sortir de la boucle d'incrémentation
Loop
 
Do
ChDir addrfeuisauv
fName = Application.GetSaveAsFilename(addrfeuisauv & chaine$) 'ouvre boite de dialogue enregistrement
Loop Until fName <> False
 
ActiveWorkbook.SaveCopyAs Filename:=fName ' enregistre nouveau fichier
 
End Sub

[jackborogar]

Voici une solution pour sauvegarder avec le nom que tu souhaites:

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
Private Function CreationDossier(sDossier) As Long 'Fonction pour créer Dossier de Sauvergarde
 
    Rep = SHCreateDirectoryEx(0&, sDossier, 0&)
 
End Function
 
Sub UserF10() 'Affiche la fenêtre de sauvergarde
 
    If MsgBox("Etes-vous certain de vouloir sauvegarder ?", vbYesNo + vbQuestion, "Demande de confirmation") = vbYes Then
 
        Sauvegarde 'Si bouton Oui est préssé alors on appelle la fct sauvergarde
 
    End If
 
End Sub
Sub Sauvegarde()
 
    On Error GoTo CreerDossier 'Si il y a une erreur alors directement à la ligne CreerDossier
 
    Dim sDossier As String
 
    sDossier = "C:\TON CHEMIN" 
    Fichier = "Nom du fichier" 
 
CreerDossier:
 
    If Err.Number = 1004 Then 'Si dossier pas créer
 
        CreationDossier sDossier 'On le créer en appelant la fct "CreationDossier"
 
    End If
 
    Application.DisplayAlerts = False
    ThisWorkbook.SaveAs sDossier & "\" & Fichier & ".xls " 'Sauvergarde du dossier ave cle type que tu souhaites
    Application.DisplayAlerts = True
    MsgBox ("Votre fichier a bien été enregistré") 'Fenêtre d'information
 
    Exit Sub
 
End Sub

[Tomtomtvn]

Et ce dode fonctionne sous excel 2003 également ?
je pense à la fonction SHCreateDirectoryEx(0&, sDossier, 0&) par exemple.

[jackborogar]

Oui ce code fonctionne sous Excel 2003. Déjà testé dessus

[Tomtomtvn]

D'accord.
Merci beaucoup !

Encore une question, à quoi sert cette partie ?

Code :

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

1
2
3
4
5
Private Function CreationDossier(addrfeuisauv) As Long 'Fonction pour créer Dossier de Sauvergarde
 
    Rep = SHCreateDirectoryEx(0&, addrfeuisauv, 0&)
 
End Function

Et comment je fais pour que tout ce que tu m'a donné soit activé par un bouton ? Actuellement j'ai fait clic droit sur le bouton et affecté la macro EnregFicheTrans du coup ça ne prend pas en compte ce que tu m'a donné...

[jackborogar]

Enfaite cette fonction te permet de créer automatiquement des dossiers.

C'est à dire que sDossier (dans mon code) est le chemin et si le chemin n'existe pas (l'erreur 1004 que beaucoup de personne a) alors on créer le chemin.

Affecter une macro => Appel "UserF10"

Cdt,

PS (Le changement c'est maintenant): N'oublie pas de mettre Résolu si tu penses que le sujet est clôt