[VBA-Excel] Enregistrement d'un fichier - Nommage avec variable date => erreur 76

Version imprimable

Bonjour,

Faisant rarement des macros, je butte aujourd'hui sur un problème d'enregistrement de fichier.
J'ai défini des variables qui se répètent maintes fois dans la macro. J'aimerai les utiliser pour l'enregistrement de mon fichier, mais ma macro me renvoie une erreur 76 lorsqu'arrive la sélection du répertoire cible.
Voici la déclaration de mes variables (variables qui changeront lorsque la macro sera achevée !) :

Code:

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
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
' Définition des variables CONSTANTES
'
'
' ****************************************************************************
' LETTRE RESSOURCE
' ****************************************************************************
'
' Lettre de la ressource utilisée
Const LettreRessource As String = "S:\"
'
'
' ****************************************************************************
' CHEMINS D'ACCES
' ****************************************************************************
'
' Chemin d'accès du fichier modèle
Const CheminFichierModele As String = LettreRessource _
& "OMQ\SAME-QD\QD\Tests\"
'
' Chemin d'accès du fichier à traiter
Const CheminFichierRequete As String = LettreRessource _
& "OMQ\SAME-QD\QD\Tests\Fichiers originaux juin 07\"
'
' Chemin d'accès des fichiers finaux
Const CheminFichierFinal As String = LettreRessource _
& "OMQ\SAME-QD\QD\Tests\Fichier définitif\"
'
' Chemin d'accès du fichier web
Const CheminFichierWeb As String = LettreRessource _
& "OMQ\SAME-QD\QD\Ets inactifs INSEE\ETA-Fichier login web\"
'
'
' ****************************************************************************
' NOMS DES FICHIERS
' ****************************************************************************
'
' Nom du fichier modèle
Const NomFichierModele As String = "STINCC-Modèle et macro.xls"
'
' Nom du fichier 1 à traiter - STINCC avec LOGIN et avec AR
Const NomFichierATraiter1 As String = "STINCC avec LOGIN et avec AR"
'
' Nom du fichier 2 à traiter - STINCC avec LOGIN et sans AR
Const NomFichierATraiter2 As String = "STINCC avec LOGIN et sans AR"
'
' Nom du fichier 3 à traiter - STINCC sans LOGIN et avec AR
Const NomFichierATraiter3 As String = "STINCC sans LOGIN et avec AR"
'
' Nom du fichier 4 à traiter - STINCC sans LOGIN et sans AR
Const NomFichierATraiter4 As String = "STINCC sans LOGIN et sans AR"
'
' Nom du fichier web - ETA inactifs AESOM - Login web-yyyy-m-d
Const NomFichierWeb As String = "ETA inactifs AESOM - Login web-"
'
' Nom du fichier des entreprises - ENT inactives AESOM
Const NomFichierENT As String = "ENT inactives AESOM-"
'
' Nom du fichier des établissements - ETA inactifs AESOM
Const NomFichierETA As String = "ETA inactifs AESOM-"
'
' ****************************************************************************
' EXTENSIONS
' ****************************************************************************
'
' Extension .xls
Const XLS As String = ".xls"
'
'
' ****************************************************************************
' DATES
' ****************************************************************************
'
' Date du jour (format à l'anglaise : aaaa-m-j)
Dim DateJourRU As String
DateJourRU = DatePart("yyyy", Date) & "-" & DatePart("m", Date) & "-" & DatePart("d", Date)
'
' Date du jour (format à la française : j-m-aaaa)
Dim DateJourF As String
DateJourF = Day(Date) & "-" & Month(Date) & "-" & Year(Date)

Et voici la partie commandant l'enregistrement :

Code:

1
2
3
4
5
6
7
' Sélection du répertoire cible
    ChDir CheminFichierWeb
' Nommage et enregistrement du fichier web
    ActiveWorkbook.SaveAs Filename:= _
        CheminFichierWeb & NomFichierWeb & DateJourRU & XLS _
        , FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False

Pouvez-vous m'aider à résoudre mon problème ? A noter que la macro fonctionne avec le code suivant :

Code:

1
2
3
4
5
6
7
8
' Sélection du répertoire
    ChDir CheminFichierWeb
' Nommage et enregistrement du fichier
    ActiveWorkbook.SaveAs Filename:= _
        CheminFichierWeb & NomFichierWeb _
        & DatePart("yyyy", Date) & "-" & DatePart("m", Date) & "-" & DatePart("d", Date) & XLS _
        , FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False

Bruno

Soir Bon,je n'ai pas tout lu mais en adaptant à ton contexte

Code:

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
 
Option Explicit
 
    ...
    if CreationDossier(CheminFichierWeb) then
         ActiveWorkbook.SaveAs ....
    Else
        MsgBox "Chemin d'Accès introuvable"
        Exit Sub
    End If
    ...
 
Private Function CreationDossier(ByVal sPath As String) As Boolean
Dim i As Integer
Dim sTmp As String
Dim Ar() As String
 
    Ar = Split(sPath, "\")
 
    sTmp = Ar(0)
    For i = LBound(Ar) + 1 To UBound(Ar)
        If Ar(i) <> "" Then
            sTmp = sTmp & "\" & Ar(i)
            On Error Resume Next
            MkDir sTmp
            On Error GoTo 0
        End If
    Next
 
    If Dir(sPath, vbDirectory) = "" Then
        CreationDossier = False
    Else
        CreationDossier = True
    End If
End Function

Tu peux également alléger ton code en

Code:

1
2
3
ActiveWorkbook.SaveAs Filename:= _
                          CheminFichierWeb & NomFichierWeb _
                          & DatePart("yyyy", Date) & "-" & DatePart("m", Date) & "-" & DatePart("d", Date) & XLS

Code:

1
2
ActiveWorkbook.SaveAs Filename:= _
                CheminFichierWeb & NomFichierWeb & DateJourRU & XLS

et noter qu'il existe également ActiveWorkbook.SaveCopyAs Filename:= ...

Bonjour kiki29,

Merci pour ton aide, et désolé pour ma réponse tardive, mais je n'ai même pas encore eu le temps de tester :?

Avant cela, j'aimerai comprendre ton code, histoire de ne pas le reproduire bêtement et d'évoluer un peu ;) ... et j'avoue que je coince :oops: (je rappelle que je suis débutant :oops:).

D'autre part, peux-tu m'indiquer où positionner tout ça ?

Enfin, j'ai aussi cherché une solution avant de lire la tienne, et j'ai trouvé ça pour définir les variables dates :
Code:

1 2 3 4 5 6 7 ' Date du jour (format à l'anglaise : aaaa-m-j) Dim DateJourRU As String DateJourRU = Year(Now) & "-" & Month(Now) & "-" & Day(Now) ' ' Date du jour (format à la française : j-m-aaaa) Dim DateJourF As String DateJourF = Day(Now) & "-" & Month(Now) & "-" & Year(Now)
... ce qui donne pour l'enregistrement du fichier :
Code:

1 2 3 4 5 ' Sélection du répertoire cible ChDir CheminFichierWeb ' Nommage et enregistrement du fichier web ActiveWorkbook.SaveAs Filename:= _ CheminFichierWeb & NomFichierWeb & DateJourRU & XLS
... et pour le nommage d'une feuille :
Code:

1 2 ' Nommage de la feuille ActiveSheet.Name = "STINCC-Web au " & DateJourF
Hélas, ces concaténations de variables fonctionnent très bien lorsque je les teste seules avec MsgBox, mais pas lorsqu'elles sont dans ma macro (erreur 76 pour l'enregistrement, affichage seulement de "STINCC-Web au " pour le nommage) ... que je ne peux, hélas, mettre ici car un peu longue ... à moins de l'envoyer par mail ? Une idée sur les raisons de ce plantage ?

Bruno

12/09/2007, 13h28
lucfrfr

Est-tu sur du chemin d'accès pour l'enregistrement ?
Je pense que ton erreur provient de là.
Un dossier ne doit pas exister avec le nom que tu lui indique.
Vérifie les liens vers les repertoires.

Remplacer

Code:

1
2
3
4
5
6
7
8
 
' Sélection du répertoire cible
    ChDir CheminFichierWeb
' Nommage et enregistrement du fichier web
    ActiveWorkbook.SaveAs Filename:= _
        CheminFichierWeb & NomFichierWeb & DateJourRU & XLS _
        , FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False

par

Code:

1
2
3
4
5
6
7
8
 
    if CreationDossier(CheminFichierWeb) then
         ActiveWorkbook.SaveAs Filename:= _
                CheminFichierWeb & NomFichierWeb & DateJourRU & XLS
    Else
        MsgBox "Chemin d'Accès introuvable"
        Exit Sub
    End If

Mettre après tes procédures la fonction

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
 
Private Function CreationDossier(ByVal sPath As String) As Boolean
Dim i As Integer
Dim sTmp As String
Dim Ar() As String
 
    Ar = Split(sPath, "\")
 
    sTmp = Ar(0)
    For i = LBound(Ar) + 1 To UBound(Ar)
        If Ar(i) <> "" Then
            sTmp = sTmp & "\" & Ar(i)
            On Error Resume Next
            MkDir sTmp
            On Error GoTo 0
        End If
    Next
 
    If Dir(sPath, vbDirectory) = "" Then
        CreationDossier = False
    Else
        CreationDossier = True
    End If
End Function

de même pour

Code:

1
2
 
    DateJourRU = Year(Now) & "-" & Month(Now) & "-" & Day(Now)

à remplacer par

Code:

1
2
 
    DateJourRU = Format(Now, "yyyy-mm-dd")

Bonjour lucfrfr,

C'est la première chose que j'ai vérifié. J'ai même créé un raccourci du fichier, copié le chemin dans la propriété du raccourci, et collé dans mon code.
Oui, je suis sûr du chemin, car les commandes d'enregistrement et de nommage fonctionnent très bien dans un fichier vide, avec la macro simplifiée ci-dessous qui me sert pour tester certaines commandes :

Code:

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
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
Sub Macro1()
'
' Macro1 Macro
' Macro enregistrée le 10/09/2007
'
' ############################################################################
' LETTRE RESSOURCE
' ############################################################################
'
' Lettre de la ressource utilisée
Const LettreRessource As String = "S:\"
'
'
' ****************************************************************************
' CHEMINS D'ACCES
' ****************************************************************************
'
' Chemin d'accès du fichier modèle
Const CheminFichierModele As String = LettreRessource _
& "OMQ\SAME-QD\QD\Tests\"
'
' Chemin d'accès du fichier à traiter
Const CheminFichierRequete As String = LettreRessource _
& "OMQ\SAME-QD\QD\Tests\Fichiers originaux juin 07\"
'
' Chemin d'accès des fichiers finaux
Const CheminFichierFinal As String = LettreRessource _
& "OMQ\SAME-QD\QD\Tests\Fichier définitif\"
'
' Chemin d'accès du fichier web
Const CheminFichierWeb As String = LettreRessource _
& "OMQ\SAME-QD\QD\Ets inactifs INSEE\ETA-Fichier login web\"
'
'
' ****************************************************************************
' NOMS DES FICHIERS
' ****************************************************************************
'
' Nom du fichier modèle
Const NomFichierModele As String = "STINCC-Modèle et macro.xls"
'
' Nom du fichier 1 à traiter - STINCC avec LOGIN et avec AR
Const NomFichierATraiter1 As String = "STINCC avec LOGIN et avec AR"
'
' Nom du fichier 2 à traiter - STINCC avec LOGIN et sans AR
Const NomFichierATraiter2 As String = "STINCC avec LOGIN et sans AR"
'
' Nom du fichier 3 à traiter - STINCC sans LOGIN et avec AR
Const NomFichierATraiter3 As String = "STINCC sans LOGIN et avec AR"
'
' Nom du fichier 4 à traiter - STINCC sans LOGIN et sans AR
Const NomFichierATraiter4 As String = "STINCC sans LOGIN et sans AR"
'
' Nom du fichier web - ETA inactifs AESOM - Login web-yyyy-m-d
Const NomFichierWeb As String = "ETA inactifs AESOM - Login web-"
'
' Nom du fichier des entreprises - ENT inactives AESOM
Const NomFichierENT As String = "ENT inactives AESOM-"
'
' Nom du fichier des établissements - ETA inactifs AESOM
Const NomFichierETA As String = "ETA inactifs AESOM-"
'
' ****************************************************************************
' EXTENSIONS
' ****************************************************************************
'
' Extension .xls
Const XLS As String = ".xls"
'
'
' ****************************************************************************
' DATES
' ****************************************************************************
'
' Date du jour (format à l'anglaise : aaaa-m-j)
Dim DateJourRU As String
DateJourRU = Year(Now) & "-" & Month(Now) & "-" & Day(Now)
'
' Date du jour (format à la française : j-m-aaaa)
Dim DateJourF As String
DateJourF = Day(Now) & "-" & Month(Now) & "-" & Year(Now)
'
'
'
MsgBox CheminFichierWeb & NomFichierWeb & DateJourRU & XLS
'
' Ajout d'une 2ème feuille
    Sheets("Feuil1").Select
    Sheets.Add
' Déplacement de la feuille dans un nouveau fichier
    Sheets("Feuil2").Select
    Sheets("Feuil2").Move
' Nommage de la feuille
    ActiveSheet.Name = "STINCC-Web au " & DateJourF
'
' Sélection du répertoire
    ChDir CheminFichierWeb
' Nommage et enregistrement du fichier
    ActiveWorkbook.SaveAs Filename:= _
        CheminFichierWeb & NomFichierWeb & DateJourRU & XLS
' Fermeture du fichier web
    ActiveWindow.Close
'
End Sub

Je pense donc qu'il s'agit d'une incompatibilité avec un autre élément de ma macro.

Bruno

12/09/2007, 15h16
brunop3165

:oops: Je n'ai pas vu ta réponse kiki29, j'étais en train d'écrire la mienne :oops:
J'essaye de suite !
12/09/2007, 15h26
brunop3165

Bon, j'ai modifié la macro et l'ai lancée. A la ligne ...

Code:

sTmp = Ar(0)

... j'obtiens le message d'erreur suivant :

Erreur d'exécution '9':

L'indice n'appartient pas à la sélection

:cry:
12/09/2007, 15h33
kiki29

Tu n'as pas un Option Base 1 qui traine qqpart
Ou plutôt sPath doit être VIDE
12/09/2007, 15h54
brunop3165

C'est quoi, ça ?

Ton code c'est un peu le bazar, commence par déclarer tes variables
Option Explicit obligatoire

Mon code de test

Code:

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
54
55
56
57
58
59
60
61
62
63
64
65
 
Option Explicit
 
Const LettreRessource = "S:\"
 
Const CheminFichierModele As String = LettreRessource _
      & "OMQ\SAME-QD\QD\Tests\"
Const CheminFichierRequete As String = LettreRessource _
      & "OMQ\SAME-QD\QD\Tests\Fichiers originaux juin 07\"
Const CheminFichierFinal As String = LettreRessource _
      & "OMQ\SAME-QD\QD\Tests\Fichier définitif\"
Const CheminFichierWeb As String = LettreRessource _
      & "OMQ\SAME-QD\QD\Ets inactifs INSEE\ETA-Fichier login web\"
 
Const NomFichierModele As String = "STINCC-Modèle et macro.xls"
Const NomFichierATraiter1 As String = "STINCC avec LOGIN et avec AR"
Const NomFichierATraiter2 As String = "STINCC avec LOGIN et sans AR"
Const NomFichierATraiter3 As String = "STINCC sans LOGIN et avec AR"
Const NomFichierATraiter4 As String = "STINCC sans LOGIN et sans AR"
Const NomFichierWeb As String = "ETA inactifs AESOM - Login web-"
Const NomFichierENT As String = "ENT inactives AESOM-"
Const NomFichierETA As String = "ETA inactifs AESOM-"
 
Const XLS As String = ".xls"
 
Private Function CreationDossier(ByVal sPath As String) As Boolean
Dim i As Integer
Dim sTmp As String
Dim Ar() As String
 
    Ar = Split(sPath, "\")
    sTmp = Ar(0)
 
    For i = LBound(Ar) + 1 To UBound(Ar)
        If Ar(i) <> "" Then
            sTmp = sTmp & "\" & Ar(i)
            On Error Resume Next
            MkDir sTmp
            On Error GoTo 0
        End If
    Next
 
    If Dir(sPath, vbDirectory) = "" Then
        CreationDossier = False
    Else
        CreationDossier = True
    End If
End Function
 
Sub Test()
Dim Dossier As String
Dim DateJourRU As String
 
    DateJourRU = Format(Now, "yyyy-mm-dd")
 
    Dossier = CheminFichierWeb
 
    If CreationDossier(Dossier) Then
            ActiveWorkbook.SaveCopyAs Filename:= _
                          CheminFichierWeb & NomFichierWeb _
                          & DateJourRU & XLS
    Else
        MsgBox "Chemin d'Accès introuvable"
    End If
End Sub

13/09/2007, 15h25
brunop3165

Bonjour,

Génial, tout fonctionne au mieux, même le nommage de la feuille :D Merci beaucoup :D