Problème enregistrement sous de fichier dans nouveau dossier
Bonjour,
Je fais face à un problème que j'essaye de résoudre depuis longtemps.
Le principe de mon programme est simple: il y a deux userform où l'utilisateur sélectionne ou donne des infos. Ces infos seront retranscrites sur un fichier excel. Lorsque ce fichier est rempli, on créé un nouveau dossier et on utilise la méthode saveas pour enregistrer le fichier sous un autre nom dans ce nouveau dossier. Mais voilà, le problème est que lorsque je fais fonctionner la macro je reçois le message d'erreur "La méthode saveas de l'objet '_Workbook' a échoué". Cependant, lorsque j'essaye d'enregistrer dans le dossier global contenant le fichier contenant la macro, ça fonctionne bien, ce qui signifie que lors du saveas le nouveau dossier n'est pas trouvé, ce que je ne comprends pas. En parallèle de cela je rempli un fichier appelé BDD_DE. Le fichier que je rempli et qui est important apparait dans le code comme étant UserForm1.Nom_Essai.Value & ".xlsx".
Voici le code du second userform:
Private Sub CommandButton1_Click()
If ComboBox1.Value <> "" And ComboBox2.Value <> "" And ComboBox4.Value <> "" And ComboBox5.Value <> "" And ComboBox6.Value <> "" And ComboBox7.Value <> "" And ComboBox8.Value <> "" And ComboBox9.Value <> "" And TextBox1.Value <> "" And TextBox2.Value <> "" And TextBox3.Value <> "" And TextBox5.Value <> "" And TextBox6.Value <> "" And TextBox8.Value <> "" Then
reponse = MsgBox("Etes-vous sûr de vouloir continuer?", vbYesNo)
If reponse = vbYes Then
'création du nouveau dossier
Call CreationDossier
Application.ScreenUpdating = False
Workbooks.Open "\\f-renoutet\home2$\p080042\MyDocs\Programmation\" & UserForm1.Nom_Essai.Value & ".xlsx", ReadOnly = True
'Remplissage du fichier source
Workbooks(UserForm1.Nom_Essai.Value & ".xlsx").Sheets("DE").Cells(8, 9) = UserForm1.Nom.Value
Workbooks(UserForm1.Nom_Essai.Value & ".xlsx").Sheets("DE").Cells(10, 9) = UserForm1.UET.Value
Workbooks(UserForm1.Nom_Essai.Value & ".xlsx").Sheets("DE").Cells(14, 9) = UserForm1.TextBox1.Value
Workbooks(UserForm1.Nom_Essai.Value & ".xlsx").Sheets("DE").Cells(33, 6) = UserForm1.Nom_Essai.Value
Workbooks(UserForm1.Nom_Essai.Value & ".xlsx").Sheets("DE").Cells(33, 2) = UserForm1.PE.Value
Workbooks(UserForm1.Nom_Essai.Value & ".xlsx").Sheets("DE").Cells(29, 9) = UserForm1.Zone.Value
Workbooks(UserForm1.Nom_Essai.Value & ".xlsx").Sheets("DE").Cells(39, 5) = UserForm1.CdC.Value
If UserForm1.CheckBox1 = True Then
Workbooks("\\f-renoutet\home2$\p080042\MyDocs\Programmation\" & UserForm1.Nom_Essai.Value & ".xlsx").Sheets("DE").Cells(11, 9) = Left(Split(UserForm1.Nom.Value, " ")(0), Len(Split(UserForm1.Nom.Value, " ")(0)) - 1) & "." & Split(UserForm1.Nom.Value, " ")(1) & "-renexter@renault.com"
Else: Workbooks(UserForm1.Nom_Essai.Value & ".xlsx").Sheets("DE").Cells(11, 9) = Left(Split(UserForm1.Nom.Value, " ")(0), Len(Split(UserForm1.Nom.Value, " ")(0)) - 1) & "." & Split(UserForm1.Nom.Value, " ")(1) & "@renault.com"
End If
Workbooks.Open "\\f-renoutet\home2$\p080042\MyDocs\Programmation\" & "BDD_DE.xlsx"
Windows("BDD_DE.xlsx").Visible = False
Dim Lig15 As Long
Lig15 = 2 'première ligne à vérifier
Do While Not IsEmpty(Workbooks("BDD_DE").Sheets("Feuil1").Range("A" & Lig15))
Lig15 = Lig15 + 1
Loop
Workbooks("BDD_DE").Sheets("Feuil1").Cells(Lig15, 1) = UserForm1.TextBox1.Value
Workbooks("BDD_DE").Sheets("Feuil1").Cells(Lig15, 2) = UserForm1.Nom.Value
Workbooks("BDD_DE").Sheets("Feuil1").Cells(Lig15, 4) = UserForm1.Nom_Essai.Value
Workbooks("BDD_DE").Sheets("Feuil1").Cells(Lig15, 3) = UserForm1.Zone.Value
Workbooks("BDD_DE").Close True
Workbooks(UserForm1.Nom_Essai.Value & ".xlsx").Sheets("DE").Cells(29, 2) = TextBox1.Value
Workbooks(UserForm1.Nom_Essai.Value & ".xlsx").Sheets("DE").Cells(29, 6) = ComboBox2.Value
Workbooks(UserForm1.Nom_Essai.Value & ".xlsx").Sheets("DE").Cells(29, 8) = ComboBox1.Value
Workbooks(UserForm1.Nom_Essai.Value & ".xlsx").Sheets("DE").Cells(39, 11) = ComboBox9.Value
Workbooks(UserForm1.Nom_Essai.Value & ".xlsx").Sheets("DE").Cells(31, 2) = ComboBox4.Value
Workbooks(UserForm1.Nom_Essai.Value & ".xlsx").Sheets("DE").Cells(31, 6) = ComboBox5.Value
Workbooks(UserForm1.Nom_Essai.Value & ".xlsx").Sheets("DE").Cells(31, 7) = TextBox2.Value
Workbooks(UserForm1.Nom_Essai.Value & ".xlsx").Sheets("DE").Cells(31, 8) = ComboBox6.Value
Workbooks(UserForm1.Nom_Essai.Value & ".xlsx").Sheets("DE").Cells(35, 11) = TextBox8.Value
Workbooks(UserForm1.Nom_Essai.Value & ".xlsx").Sheets("DE").Cells(37, 11) = TextBox5.Value
Workbooks(UserForm1.Nom_Essai.Value & ".xlsx").Sheets("DE").Cells(41, 11) = TextBox6.Value
Workbooks(UserForm1.Nom_Essai.Value & ".xlsx").Sheets("DE").Cells(41, 5) = ComboBox8.Value
Workbooks(UserForm1.Nom_Essai.Value & ".xlsx").Sheets("DE").Cells(37, 5) = TextBox3.Value
Workbooks(UserForm1.Nom_Essai.Value & ".xlsx").Sheets("DE").Cells(35, 5) = ComboBox7.Value
Workbooks(UserForm1.Nom_Essai.Value & ".xlsx").Sheets("DE").Cells(44, 2) = TextBox7.Value
NouveauFichier = dossier_DE & "\" & UserForm1.NomNouveauFichier
MsgBox (NouveauFichier)
Workbooks(UserForm1.Nom_Essai.Value & ".xlsx").SaveAs Filename:=dossier_DE & "\" & UserForm1.NomNouveauFichier
ActiveWorkbook.Close
UserForm2.Hide
End If
Else: MsgBox "Veuillez fournir toutes les informations demandées."
End If
End Sub
Private Sub CreationDossier()
Set fs = CreateObject("Scripting.FileSystemObject")
dossier_DE = "\\f-renoutet\home2$\p080042\MyDocs\Programmation\Dossier_" & UserForm1.Nom_Essai.Value & "_" & UserForm1.TextBox1.Value & "_" & UserForm1.Nom.Value
fs.createfolder (dossier_DE)
End Sub
Pouvez-vous m'aider s'il vous plait? Je suis débutant en Vba et je ne vois absolument pas comment résoudre ce problème qui a pourtant l'air simple.
Merci d'avance de votre aide.
JulienCOR