XL 2019 bug dans l'enregistrement (VBA)

[bluesky12000]

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 :

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

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

 

[sylvanu]

Bonsoir BlueSky,
Est ce que le nom du fichier affiché dans le msgbox est correct ?

MsgBox (NomDuFichier)

 

[bluesky12000]

Bonsoir BlueSky,
Est ce que le nom du fichier affiché dans le msgbox est correct ?

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

 

[Staple1600]

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

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]

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

Voici la version précédente pour comparer :

 

[Staple1600]

Re

Mon code comme je précisait n'est qu'un test

Une proposition (pour ce qui est de la création du nom)
[/code]
C'est pour cela qu'il n'affiche qu'un MsgBox
Si le NomduFichier est bon, alors je passe à la suite

 

[Staple1600]

Corrections

J'avais oublié le formatage de B19

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]

Merci encore Staple,

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

w2.SaveAs NomDuFichier

 

[Staple1600]

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]

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