XL 2019 bug dans l'enregistrement (VBA)

bluesky12000

XLDnaute Junior
Bonjour à tous,

J'ai enfin créé mon premier long macro 😄

En gros, il copie la première feuille du classeur w1 et la colle en première position du classeur w2
Il enregistre ensuite le classeur w2 sous un nouveau nom composé de plusieurs cellules de la feuille copiée dans un chemin (3 sous-dossiers) défini par plusieurs cellules de la feuille copiée.

Le code en version simple fonctionnait très bien, mais depuis que j'ai inclus des vérifications de l'existence de dossier celui ne fonctionne plus.

Je me retrouve avec cette erreur :
1614965244618.png


Tous les dossiers existent bien. Le nom en jaune ne correspond à rien que je puisse identifier. A la place cela devrait être le nom du fichier.

Quelqu'un aurait-il le courage de regarder s'il y a un problème avec la ligne en rouge (4ème en partant de la fin) ?

w2.SaveAs Filename:=Chemin & "\" & NomDuFichier & ".xlsm"



Merci beaucoup et bon weekend :)

Code:
Sub Creer_Projet()

Application.ScreenUpdating = True

Dim w1 As Workbook
Dim w2 As Workbook
Dim NomDuFichier As String
Dim NomDuTemplate As String
Dim NomDuDossier As String
Dim NomDuSousDossier1 As String
Dim NomDuSouSDossier2 As String
Dim Chemin As String
Dim CheminDuDossier As String
Dim CheminDuSousDossier1 As String
Dim CheminDuSousDossier2 As String
Dim fso As Object


' Défni w1 comme le classeur avec le macro
Set w1 = ThisWorkbook

' Défini le nom du fichier final

' Si le pays 3 n'est pas vide alors nom avec les 3 pays
If w1.Sheets(1).Range("F34") <> "" Then
NomDuFichier = "CoBALT - " & w1.Sheets(1).Range("B8").Value & " - " & w1.Sheets(1).Range("D8").Value & " - " & _
   w1.Sheets(1).Range("B11").Value & " Pax" & " - " & w1.Sheets(1).Range("B16").Value & "J" & " - " & Format(w1.Sheets(1).Range("B19").Value, "yyyy") & " (" & _
   w1.Sheets(1).Range("B34").Value & " - " & w1.Sheets(1).Range("D34").Value & " - " & w1.Sheets(1).Range("F34").Value & ") - Version " & w1.Sheets(1).Range("H4").Value
 
   End If
 
' Si le pays 3 est vide alors nom avec les 2 premiers pays
If w1.Sheets(1).Range("F34") = "" Then

NomDuFichier = "CoBALT " & " - " & w1.Sheets(1).Range("B8").Value & " - " & w1.Sheets(1).Range("D8").Value & " - " & _
   w1.Sheets(1).Range("B11").Value & " Pax" & " - " & w1.Sheets(1).Range("B16").Value & "J" & " - " & Format(w1.Sheets(1).Range("B19").Value, "yyyy") & " (" & _
   w1.Sheets(1).Range("B34").Value & " - " & w1.Sheets(1).Range("D34").Value & ") - Version " & w1.Sheets(1).Range("H4").Value
 
   End If
 
' Si le pays et le pays 3 sont vides alors nom avec le premier pays
If w1.Sheets(1).Range("D34") = "" And w1.Sheets(1).Range("F34") = "" Then

NomDuFichier = "CoBALT " & " - " & w1.Sheets(1).Range("B8").Value & " - " & w1.Sheets(1).Range("D8").Value & " - " & _
   w1.Sheets(1).Range("B11").Value & " Pax" & " - " & w1.Sheets(1).Range("B16").Value & "J" & " - " & Format(w1.Sheets(1).Range("B19").Value, "yyyy") & " (" & _
   w1.Sheets(1).Range("B34").Value & ") - Version " & w1.Sheets(1).Range("H4").Value
 
   End If
 
   MsgBox (NomDuFichier)
 
' Défini le nom du dossier avec le nom de l'agence
NomDuDossier = w1.Sheets(1).Range("B8").Value
' Défni le nom du sous dossier de l'année de la demande de l'agence
NomDuSousDossier1 = Format(Now, "yyyy")
' Défini le nom du sous dossier 2 avec le nom du projet et l'année du projet
NomDuSouSDossier2 = w1.Sheets(1).Range("D8").Value & " - " & Format(w1.Sheets(1).Range("B19").Value, "yyyy")
' Défini le nom du template comme le nombre de jour dans le classeur de référence
NomDuTemplate = "CoBALT - Cotation " & w1.Sheets(1).Range("B16").Value & " jours"


' Définir le chemin du dossier du nom de l'agence
CheminDuDossier = "C:\Users\Clément\Desktop\CoBALT Final\ " & NomDuDossier
' Vérifie si le dossier existe déjà
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FolderExists(CheminDuDossier) Then
MsgBox "Le dossier d'enregistrement existe déjà", vbInformation, "Information"
Else
' Crée le dossier au nom de l'agence
MkDir CheminDuDossier
End If

' Défini le chemin du dossier de l'année de la demande de l'agence
CheminDuSousDossier1 = "C:\Users\Clément\Desktop\CoBALT Final\ " & NomDuDossier & "\" & NomDuSousDossier1
' Vérifie si le dossier existe déjà
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FolderExists(CheminDuSousDossier1) Then
MsgBox "Le sous dossier 1 existe déjà", vbInformation, "Information"
Else
' Crée le dossier de l'année de la demande de l'agence
MkDir CheminDuSousDossier1
End If

' Défini le chemin du dossier avec le nom du projet et l'année du projet
CheminDuSousDossier2 = "C:\Users\Clément\Desktop\CoBALT Final\ " & NomDuDossier & "\" & NomDuSousDossier1 & "\" & NomDuSouSDossier2
' Vérifie si le dossier existe déjà
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FolderExists(CheminDuSousDossier2) Then
MsgBox "Le sous dossier 2 existe déjà", vbInformation, "Information"
Else
' Crée le dossier avec le nom du projet et l'année du projet
MkDir CheminDuSousDossier2
End If

' Donne le chemin de destination du fichier rendu
Chemin = "C:\Users\Clément\Desktop\CoBALT Final\" & NomDuDossier & "\" & NomDuSousDossier1 & "\" & NomDuSouSDossier2

' Ouvre le template selon le nombre de jour dans le fichier de référence
Workbooks.Open Filename:="C:\Users\Clément\Desktop\CoBALT Final\" & NomDuTemplate & ".xlsm"

' Défini w2 comment le dernier classeur ouvert
Set w2 = Workbooks(Workbooks.Count)

' Copier la feuille numéro 1 en premier position du dernier classeur ouvert
w1.Sheets(1).Copy Before:=w2.Sheets(1)

' Sauvegarde ce classeur dans un nouveau classeur dans le chemin défini
w2.SaveAs Filename:=Chemin & "\" & NomDuFichier & ".xlsm"

' Ferme sans sauvegarder le classeur de référence
w1.Close False

End Sub
 

bluesky12000

XLDnaute Junior
Bonsoir BlueSky,
Est ce que le nom du fichier affiché dans le msgbox est correct ?
VB:
MsgBox (NomDuFichier)
Bonsoir Sylvanu,

oui le nom est bien correct selon les 3 conditions possibles

Merci d'avoir regardé :)

Voici la version simplifiée qui créé bien le fichier sur le chemin D:\Documents.
Pour changer le fichier de destination (book2 ou book3) il faut modifier la valeur de la la cellule A2 sur la feuille 1 du book1
 

Pièces jointes

  • Book1.xlsm
    18.3 KB · Affichages: 8
  • Book2.xlsm
    9 KB · Affichages: 2
  • Book3.xlsm
    9 KB · Affichages: 2
Dernière édition:

Staple1600

XLDnaute Barbatruc
Bonsoir le fil, bluesky12000, sylvanu

Une proposition (pour ce qui est de la création du nom)
Tu peux tester pour savoir si le résultat est le bon
VB:
Sub Creer_Projet_test()
Dim w1 As Workbook, w2 As Workbook, t
Dim NomDuFichier$, NomDuTemplate$, NomDuDossier$, NomDuSousDossier1$, NomDuSouSDossier2$
Dim Chemin$, CheminDuDossier$, CheminDuSousDossier1$, CheminDuSousDossier2$
Dim fso As Object
' Défni w1 comme le classeur avec le macro
Set w1 = ThisWorkbook
With w1.Sheets(1)
    t = Array("CoBALT", .[B8], .[D8], .[B11], "Pax", .[B16], .[B19])
    pref = Join(t, " - ")
    fin = ") - Version " & .[H4]
        If Len(.[F34]) > 0 Then
        milieu = " (" & .[B34] & " - " & .[D34] & " - " & .[F34]
        ElseIf Len(.[F34]) = 0 And Len(.[D34]) > 0 Then
        milieu = " (" & .[B34] & " - " & .[D34]
        ElseIf Len(.[D34]) = 0 And Len(.[F34]) = 0 Then
        milieu = " (" & .[B34]
    End If
End With
NomDuFichier = pref & milieu & fin
MsgBox NomDuFichier
End Sub
 

bluesky12000

XLDnaute Junior
Bonsoir Staple,

Merci à toi de venir m'aider. Oui ton code fonctionne très bien et est très instructif. Il me montre comment simplifier mes nombreuses lignes 😓 , par contre il me créé un autre nom de dossier (qui n'est pas créé, les autres le sont) et au final j'ai la même erreur

1614969424831.png


Voici la version précédente pour comparer :

1614969496898.png
 

Staple1600

XLDnaute Barbatruc
Corrections

J'avais oublié le formatage de B19
VB:
Sub Creer_Projet_test_B()
Dim w1 As Workbook, w2 As Workbook, t
Dim NomDuFichier$, NomDuTemplate$, NomDuDossier$, NomDuSousDossier1$, NomDuSouSDossier2$
Dim Chemin$, CheminDuDossier$, CheminDuSousDossier1$, CheminDuSousDossier2$
Dim fso As Object
' Défni w1 comme le classeur avec le macro
Set w1 = ThisWorkbook
With w1.Sheets(1)
    t = Array("CoBALT", .[B8], .[D8], .[B11], "Pax", .[B16], Format(.[B19], "yyyy"))
    pref = Join(t, " - ")
    fin = ") - Version " & .[H4]
        If Len(.[F34]) > 0 Then
        milieu = " (" & .[B34] & " - " & .[D34] & " - " & .[F34]
        ElseIf Len(.[F34]) = 0 And Len(.[D34]) > 0 Then
        milieu = " (" & .[B34] & " - " & .[D34]
        ElseIf Len(.[D34]) = 0 And Len(.[F34]) = 0 Then
        milieu = " (" & .[B34]
    End If
End With
NomDuFichier = pref & milieu & fin
MsgBox NomDuFichier
End Sub
 

bluesky12000

XLDnaute Junior
Merci encore Staple,

J'ai simplifié mes fichiers, bonne nouvelle avec ce code, le fichier va dans mes documents :

w2.SaveAs NomDuFichier
 

Pièces jointes

  • CoBALT - Cotation 8 jours.xlsm
    7.7 KB · Affichages: 1
  • CoBALT - Projets.xlsm
    65.5 KB · Affichages: 3

Staple1600

XLDnaute Barbatruc
Re

C'est normal puisque mon code modifié ne traite que le NomDuFichier
(je n'ai pas commencé à traiter la partie du code qui s'occupe de gérer les noms des dossiers et sous-dossiers)
Mais je repasse plus tard, car là je n'ai pas piscine, mais soirée TV ;)
 

bluesky12000

XLDnaute Junior
Bonsoir à tous,

J'ai trouvé mon erreur, en fait Chemin n'existait plus, c'était maintenant CheminDuSousDossier2 qu'il fallait utiliser.

w2.SaveAs Filename:=CheminDuSousDossier2 & "\" & NomDuFichier & ".xlsm"

Merci encore pour votre aide :)
 
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
311 720
Messages
2 081 910
Membres
101 837
dernier inscrit
Ugo