Excel plante avec macro sauvegarde feuille vers nouveau classeur avec nom spécifique

**stephadm** · 18/04/2012, 20h50

bonsoir au forum

Je souhaite faire une sauvegarde de la base Annuaire vers un nouveau classeur avec pour nom, "le nom de la feuille à sauvegarder, la date"
Enregistrer ce fichier dans dossier de l'année en cours (date système) si inexistant boite de dialogue pour l'ajouter

Voici un début de code qui hélas fait planter excel

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
Private Sub SauvCli() 
Dim MaDate As Date
Dim ChDir As String
Dim stHeureExport As String
Dim NomDest As String
 
MaDate = Format(Date, "DD-MM-YYYY")
ChDir = "D:\Gestion\Sauvegarde\2012\"
stHeureExport = "_" & _
    Format(Hour(Time), "00") & "" & Format(Minute(Time), "00") & "" & _
    Format(Second(Time), "00")
NomDest = ChDir & "\" & "Annuaire " & MaDate & " " & stHeureExport & ".xls"
 
    Sheets("Annuaire").Select
    Sheets("Annuaire").Copy
    Cells.Select
    Sheets("Dashboard").Select
    Workbooks.Add
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Application.CutCopyMode = False
    'Range("A1").Select
    ActiveWorkbook.SaveAs Filename:=NomDest, FileFormat:= _
        xlExcel8, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
        , CreateBackup:=False
    ActiveWindow.Close
 
    MsgBox "le fichier a été enregistré sous le nom : " & vbCrLf & NomDest
End Sub

Pourquoi ça plante ?

Merci

Stephanie

**fring** · 19/04/2012, 00h19

Bonjour,

une première constatation est que tu as un backslash en trop dans le chemin du fichier : NomDest = ChDir & "\" va donner comme résultat "D:\Gestion\Sauvegarde\2012\\"

**stephadm** · 19/04/2012, 08h04

bonjour fring et au forum

Étourderie de ma part. J'ai vérifié dans mon fichier et j'ai bien

Code :

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

ChDir = "D:\Gestion\Sauvegarde\2012"

Je constate une autre chose, la macro s'arrete avec encadré jaune sur

Code :

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

Sheets("Annuaire").Copy

je ne vois pas ou est l'erreur !

Avez-vous une idée ?

Merci

Stephanie

**L'Albatros** · 19/04/2012, 10h01

Bonjour,

Le problème vient de là:

Code :

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

1
2
3
4
Sheets("Annuaire").Select
    Sheets("Annuaire").Copy
    Cells.Select
    Sheets("Dashboard").Select

Vous sélectionnez une feuille, vous la copiez, vous selectionnez toutes les cellules de cette feuille, puis vous sélectionnez une autre feuille...

Cela sent l'enregistreur de macro...

Si je comprends ce que vous voulez faire, alors mettez plutôt:

Code :

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

1
2
3
4
Windows("NomFichier.xls").Activate
Sheets("Annuaire").Select
Cells.Select
Selection.Copy

Essayez déjà ça, on verra pour la suite du code

**stephadm** · 19/04/2012, 10h16

bonjour L'Albatros, fring et au forum

Effectivement, j'ai commencé par faire un enregistrement de macro puis j'ai modifié ce que je voulais et dans la limite de mes connaissances en VBA.

L'Albatros,j'ai essayé votre proposition mais hélas ça le déroulement de la macro s'arrête et souligne en jaune

Code :

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

Windows("NomFichier.xls").Activate

En parcourant le net j'avais vu comment faire mais je ne m'en souvient plus.

Y a-til une autre solution ?

Merci

Stephanie

**L'Albatros** · 19/04/2012, 10h25

Euh... j'ai mis "NomFichier" pour donner un exemple.
Il faut remplacer "NomFichier" par le nom de votre classeur Excel.
C'est bien ce que vous avez fait ?

**stephadm** · 19/04/2012, 10h42

re bonjour L'Albatros, fring et au forum

L'Abaltros, j'avais bien compris mais c'est pareil.

Comment faire pour récupérer le nom du fichier automatiquement, comme ça je ne suis pas obliger de revenir dans le code pour changer ce dernier?

J'ai refais un essai en vérifiant bien le nom mais maintenant le code s'arrête là

Code :

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

1
2
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False

encadré en jaune

Ceci doit etre correcte, non !

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
Public Sub SauvCli()Dim MaDate As Date
Dim ChDir As String
Dim stHeureExport As String
Dim NomDest As String
 
MaDate = Format(Date, "DD-MM-YYYY")
ChDir = "D:\Gestion\Sauvegarde\2012"
stHeureExport = "_" & _
    Format(Hour(Time), "00") & "" & Format(Minute(Time), "00") & "" & _
    Format(Second(Time), "00")
NomDest = ChDir & "\" & "Annuaire " & MaDate & " " & stHeureExport & ".xls"
 
    Windows("Gestion v1.00.xls").Activate
    Sheets("Annuaire").Select
    Cells.Select
    Selection.Copy
    Sheets("Dashboard").Select
    Workbooks.Add
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Application.CutCopyMode = False
    ActiveWorkbook.SaveAs Filename:=NomDest, FileFormat:= _
        xlExcel8, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
        , CreateBackup:=False
    ActiveWindow.Close
 
    MsgBox "le fichier a été enregistré sous le nom : " & vbCrLf & NomDest
End Sub

Merci

Stephanie

**L'Albatros** · 19/04/2012, 11h03

Ok, j'ai corrigé votre code, essayez ceci:

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
Public Sub SauvCli()
Dim MaDate As Date
Dim ChDir As String
Dim stHeureExport As String
Dim NomDest As String
 
MaDate = Format(Now, "DD-MM-YYYY")
ChDir = "D:\Gestion\Sauvegarde\2012"
stHeureExport = "_" & Format(Hour(Time), "00") & "" & Format(Minute(Time), "00") & "" & Format(Second(Time), "00")
NomDest = ChDir & "\" & "Annuaire " & MaDate & " " & stHeureExport & ".xls"
 
    Windows("Nouveau Feuille de calcul Microsoft Excel.xls").Activate
    Sheets("Annuaire").Select
    Cells.Select
    Selection.Copy
    Sheets("---- ACCES AU PROGRAMME ----").Select
    Workbooks.Add
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    ActiveWorkbook.SaveAs ChDir & NomDest
    ActiveWindow.Close
 
    MsgBox "le fichier a été enregistré sous le nom : " & vbCrLf & NomDest
End Sub

**stephadm** · 19/04/2012, 11h42

re bonjour L'Albatros, fring et au forum

Même erreur ! Essai avec

Code :

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

Selection.Paste

au lieu

Code :

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

    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Ne fonctionne pas non plus

Stephanie

**L'Albatros** · 19/04/2012, 11h46

Combien avez-vous de classeurs Excel, et quels sont les noms de leurs onglets respectifs ?

Parce que de mon côté, ça fonctionne...

**kiki29** · 19/04/2012, 11h51

Salut, juste une remarque : évite d'utiliser des noms de variables qui sont des mots réservés du langage, ici par exemple ChDir

**stephadm** · 19/04/2012, 12h11

re bonjour L'Albatros, kiki29

Je prend note kiki29

J'ai refais le test sur un autre fichier mais cette fois il bloque

Code :

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

    ActiveWorkbook.SaveAs ChDir & NomDest

Message erreur '1004':
Fichier inaccessible
C'est normal le fichier n'existe pas !

Autre essai

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
Sub Macro2()
Dim MaDate As Date
Dim CheminDir As String
Dim stHeureExport As String
Dim NomDest As String
 
MaDate = Format(Date, "DD-MM-YYYY")
CheminDir = "D:\Essai\"
stHeureExport = "_" & Format(Hour(Time), "00") & "" & Format(Minute(Time), "00") & "" & Format(Second(Time), "00")
NomDest = "Annuaire " & MaDate & " " & stHeureExport & ".xls"
 
    Windows("ClasseurTest.xls").Activate
    Sheets("Annuaire").Select
    Cells.Select
    Selection.Copy
    Sheets("---- ACCES AU PROGRAMME ----").Select
    Workbooks.Add
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    ActiveWorkbook.SaveAs CheminDir & NomDest
    ActiveWindow.Close
 
    MsgBox "le fichier a été enregistré sous le nom : " & vbCrLf & NomDest

Merci

Stephanie

**L'Albatros** · 19/04/2012, 12h15

kiki29 a raison, commence par remplacer tous les "ChDir" par "Chemin", puis vérifie que le chemin que tu indiques "D:\Gestion\Sauvegarde\2012" soit le bon

J'oubliais: merci aussi de me donner la structure de tes fichiers (up)
Nom des classeurs + noms des onglets respectifs

**stephadm** · 19/04/2012, 12h22

re

sur le test que je viens d'effectuer,

Non du fichier : ClasseurTest.xls
Onglets : feuil1 ("---- ACCES AU PROGRAMME ----"), feuil2 (Annuaire) et feuil3 (Feuil3)

merci

Stephanie

**L'Albatros** · 19/04/2012, 12h25

Ok, j'ai une vague intuition du problème, pourriez-vous svp me passer votre code en l'état ?

**stephadm** · 19/04/2012, 12h49

re L'Albatros,

Je vous joint le fichier, c'est plus simple pour comprendre

Merci

Stephanie

**L'Albatros** · 19/04/2012, 13h34

Voilà, j'ai refait tout 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
32
33
34
35
36
37
38
39
40
41
42
Sub SauvCli()
'----------------------------------------------------Enregistre une copie sans les macros
 Dim NomSource$, CheminDest$, NomDest$
 Dim VBC As Object
 
 MaDate = Format(Now, "DD-MM-YY h-mm-ss")
 NomSource = "ClasseurTest.xls"
 CheminDest = "D:\Essai\"
 NomDest = "Annuaire du " & MaDate & ".xls"
 
'-----------------------------------------Copie des informations
Windows("ClasseurTest.xls").Activate
Sheets("Annuaire").Select
Cells.Select
Selection.Copy
'-----------------------------------------Emplacement du collage
Sheets("---- ACCES AU PROGRAMME ----").Select
Range("A1").Select
Selection.PasteSpecial
 
'-----------------------------------------Enregistrement
 Workbooks(NomSource).SaveAs CheminDest & NomDest
 
 With ActiveWorkbook.VBProject
 
  For Each VBC In .VBComponents
   If VBC.Type = 100 Then
    With VBC.CodeModule
     .DeleteLines 1, .CountOfLines
     .CodePane.Window.Close
    End With
   Else: .VBComponents.Remove VBC
   End If
  Next VBC
 End With
 
 ActiveWorkbook.Save
 ActiveWorkbook.Close SaveChanges:=True
 Application.Quit
 SendKeys "%O"
 
 End Sub

Avant de le lancer, allez dans le menu Outils/Références et cochez la case "Microsoft Office X.X Object Library"

Chez moi ça marche parfaitement.
Si c'est le cas pour vous aussi, merci de:

me le dire
voter mes post en cliquant sur les pouces vert en bas de chaque post de cette discussion
cliquer sur "Résolu"

**stephadm** · 19/04/2012, 13h47

re bonjour L'Albatros, kiki29 et au forum

Merci L'Albatros de vous decarcassé pour moi

Je viens de faire l'essai tout en verifiant que la case "Microsoft Office 12.0 Object Library"

Dès que je clique sur le bouton "Sauvegarde"
-déroulement des etape normal jusqu'à

Code :

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

 With ActiveWorkbook.VBProject

encadre jaune
- le fichier principal s'est fermé
- le fichier destination est ouvert avec la copie de l'annuaire dans onglets Annuaire et ---- ACCES AU PROGRAMME ----
- la macro est présente en VBA

Du coup, il enregistre le document source complet alors que je souhaite uniquement avoir un onglet "Annuaire" dans document destination

Etrange tout ça !

Stephanie