Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2019 bug dans l'enregistrement (VBA)

B

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 :


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
 
Trier par date Trier par votes
B

bluesky12000

XLDnaute Junior
sylvanu à dit:
Bonsoir BlueSky,
Est ce que le nom du fichier affiché dans le msgbox est correct ?
VB: 
MsgBox (NomDuFichier)
Cliquez pour agrandir...
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:
Vote positif 0 Vote négatif

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
 
Vote positif 0 Vote négatif
B

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



Voici la version précédente pour comparer :

 
Vote positif 0 Vote négatif

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
 
Vote positif 0 Vote négatif
B

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
Vote positif 0 Vote négatif

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
 
Vote positif 0 Vote négatif
B

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:
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

  • Résolu(e)
Microsoft 365 Vba : Transférer des données d'un tableau dans un autre fichier
Réponses
7
Affichages
383
Chaton77
F
  • Question
Microsoft 365 Problème avec VBA ( Résolu)
Réponses
2
Affichages
281
firecarl
F
J
  • Question
Microsoft 365 Code VBA
Réponses
10
Affichages
725
jebibo
J
  • Résolu(e)
XL 2021 Revenir sur Excel
Réponses
6
Affichages
376
Franc58
F
M
  • Résolu(e)
XL 2013 VBA enregistrement fichier dans un dossier en particulier
Réponses
3
Affichages
285
MarineU
M
  • Question
Autres fenêtre "Publication"
Réponses
10
Affichages
402
ph.vanne
P
  • Question
XL 2019 Changer nom d'export en VBA
Réponses
3
Affichages
448
job75
M
  • Question
Microsoft 365 Erreur sur mon Code VBA
Réponses
2
Affichages
329
Gégé-45550
D
  • Résolu(e)
XL 2019 Nouveau Numéro
2 3 4
Réponses
57
Affichages
1 K
patricktoulon
D
  • Question
XL 2021 Filtre Multi Critères Listview VBA
2
Réponses
21
Affichages
1 K
Dranreb
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…