Bugs sur code macro pour formulaire devis

bonjour,

je travaille sur la réalisation d’un formulaire devis sur Excel, je vous signale que je suis novice :thinking:en VBA
j’ai réalisé une macro, en cherchant sur internet, qui doit me permettre :
d’enregistrer les données de chaque devis dans un tableau sur une feuille excel. ce fichier se trouve sur Teams pour être partagé entre tous les collaborateurs
d’imprimer le formulaire devis rempli pour l’archivage
d’imprimer le formulaire devis en pdf dans un dossier sur Teams
de vider les cellules du formulaire devis
d’incrémenter le numéro de devis
et entre les opérations je désactive et réactice les protections des feuilles
et tout ça avec un seul bouton…
cette macro fonctionne dans certains cas, mais j’ai la plupart du temps des bugs et je commence à désespérer. il doit y avoir beaucoup d’erreurs, c’est l’enregistrement des données sur Teams qui me pose le plus de problème.
voici le code de cette macro
pouvez-vous m’aider ??

Sub enregistrement()

’ enregistrement Macro


'ouvrir fichier « enregistrement devis » sur teams

Workbooks.Open Filename:= _
« https://…sharepoint.com/…enregistrement devis.xlsm » 'adresse imcompl?te volontairement

'enlever protection feuilles

Windows("formulaire devis AP.xlsm").Activate
Sheets("devis").Select
ActiveSheet.Unprotect "titi"
Windows("enregistrements devis.xlsm").Activate
Sheets("bdd").Select
ActiveSheet.Unprotect "titi"
ActiveWorkbook.LockServerFile

'enregistrement donn?es tableau

ligne = Workbooks("enregistrements devis.xlsm").Sheets("bdd").Range("A2").End(xlDown).Row + 1
Sheets("bdd").Range("B" & ligne).Value = Workbooks("formulaire devis AP.xlsm").Sheets("devis").Range("E3")
Workbooks("enregistrements devis.xlsm").Sheets("bdd").Range("C" & ligne).Value = Workbooks("formulaire devis AP.xlsm").Sheets("devis").Range("E4")
Workbooks("enregistrements devis.xlsm").Sheets("bdd").Range("D" & ligne).Value = Workbooks("formulaire devis AP.xlsm").Sheets("devis").Range("D37")
Workbooks("enregistrements devis.xlsm").Sheets("bdd").Range("E" & ligne).Value = Workbooks("formulaire devis AP.xlsm").Sheets("devis").Range("C8")
Workbooks("enregistrements devis.xlsm").Sheets("bdd").Range("F" & ligne).Value = Workbooks("formulaire devis AP.xlsm").Sheets("devis").Range("C11")
Workbooks("enregistrements devis.xlsm").Sheets("bdd").Range("G" & ligne).Value = Workbooks("formulaire devis AP.xlsm").Sheets("devis").Range("C9")
Workbooks("enregistrements devis.xlsm").Sheets("bdd").Range("H" & ligne).Value = Workbooks("formulaire devis AP.xlsm").Sheets("devis").Range("B14")
Workbooks("enregistrements devis.xlsm").Sheets("bdd").Range("I" & ligne).Value = Workbooks("formulaire devis AP.xlsm").Sheets("devis").Range("D27")

'enregistrer et fermer fichier

Windows("enregistrements devis.xlsm").Activate
Sheets("bdd").Select
ActiveWorkbook.Save
ActiveSheet.Protect "titi", True, True, True
ActiveWorkbook.Close

'imprimer devis

Sheets("devis").PrintOut From:=1, To:=1

'pdf_enregistrement

'd?claration des variables
Dim NomFichier As String
'Dim Chemin As String

'Nom de dossier
NomFichier = Range("E3").Value & ".pdf"
Chemin = "https://.....sharepoint.com........./devis/" & NomFichier 'adresse imcompl?te volontairement

'enregistrement au format pdf
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Chemin, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False

'bo?te de dialogue

MsgBox ("cliquer sur OK pour nouveau devis")

'suppression donn?es

Range("C8:C10").ClearContents
Range("B13:B14").ClearContents
Range("A17:A26").ClearContents
Range("B17:B26").ClearContents
Range("C17:C26").ClearContents
Range("E17:E26").ClearContents

'incr?mentation num?ro

Sheets("devis").Select
Sheets("donn?es").Visible = True
If Range("E10") <> "" Then
If Range("E10") = Format(Date, "yyyy") * 1 Then
Range("G10") = Range("G10") + 1
Else
Range("G10") = 1
Range("E10") = Format(Date, "yyyy")
End If
Else
Range("G10") = 1
Range("E10") = Format(Date, "yyyy")
End If
Sheets("donn?es").Select
ActiveWindow.SelectedSheets.Visible = False

'protection feuille

Windows("formulaire devis AP.xlsm").Activate
Sheets("devis").Select
ActiveSheet.Protect "titi", True, True, True

End Sub

Bonjour

Il va être très difficile de te répondre sans avoir les fichiers concernés lorsqu’il y a bug
Tu sembles dire que parfois cela fonctionne
Si tel est le cas le code est dans sa composition sans erreur sinon il ne pourrait jamais fonctionner
Je te rassures de ce côté là
Non si c’est tel que tu le décris un code qui dans son approche répond correctement avec le traitement de certains fichiers mais incorrectements pour les autres il n’est pas à incriminer dans son écriture
Pour en trouver la cause il faut être en présence du contexte donc des fichiers concernés et cerner ce qui dans le déroulement pose problème
Je relève déjà cette ligne de code qui me semble pas appropriée pour son objectif recherché :

ligne = Workbooks(« enregistrements devis.xlsm »).Sheets(« bdd »).Range(« A2 »).End(xlDown).Row + 1

Tu cherches avec cette instruction à déterminer la 1° ligne libre
Pour cela tu demandes de déterminer à partir de la cellule A2 la 1° cellule qui n’est pas dans le même état
Si A2 non vide la 1° cellule vide
Si A2 vide la 1° cellule non vide
C’est l’objectif de cette instruction :
Workbooks(« enregistrements devis.xlsm »).Sheets(« bdd »).Range(« A2 »).End(xlDown).Row

Or peux tu être certain que jusqu’à la 1° ligne disponible toutes les cellules de la colonne A sont dans le même état
Je suppose que l’état de A2 est non vide il faut impérativement que toutes les cellules de cette colonne soit non vides pour détecter la 1° ligne de libre qui elle aura sa cellule colonne A vide
Si par un hasard malencontreux une ou plusieurs cellules de cette colonne n’ont pas de données avant la 1° ligne libre tu ne la détecteras pas mais détecteras celle de la 1° cellule sans donnée de la colonne A
C’est pour cela que pour arriver à bien cerner la bonne ligne libre il faut utiliser l’instruction qui part de la dernière cellule de la feuille qui est vide et remonter jusqu’à la 1° pleine avec cette écriture :

Workbooks(« enregistrements devis.xlsm »).Sheets(« bdd »).Range(« A » & Rows.Count).End(xlUp).Row + 1

Avec cette manière d’opérer on s’affranchit des aléas de présence de donnée et d’être certain d’avoir cibler la bonne 1° ligne de libre juste à être certain que la dernière ligne de donnée a sa cellule colonne A remplie sinon utiliser une autre colonne

C’est la seule petite objection que je puisse faire
Sinon déjà il serait souhaitable d’avoir la ou les lignes de code qui bug et le message du bug
a défaut des fichiers concernés
A toi de voire ce que tu peux faire

bonsoir FFO,

merci pour ton analyse et tes explications
je te joins les deux fichiers Excel
les données du fichier « formulaire devis AP 1 » sont recopiées dans le tableau du fichier « enregistrement devis 1 » qui se trouve sur Teams.
l’enregistrement en pdf du « formulaire devis AP 1 » se fait également sur Teams dans le dossier « DEVIS »
si tu peux m’aider et faire en sorte que cela fonctionne j’en serais très heureux
formulaire devis AP 1.xlsm (24,4 Ko)
enregistrement devis 1.xlsm (11,6 Ko)

Bonsoir
Merci pour les fichiers
Je regarde et te dis demain au plus tard

Bonjour

Ci-joint ton fichier « formulaire devis AP 1.xlsm » avec quelques modifications

Le fichier cible se nomme « enregistrement devis 1.xlsm » et non « enregistrements devis 1.xlsm »
Il n’y a pas de lettre « s » en fin du mot « enregistrement »
Dans ton code tu fait appel au fichier « enregistrements devis.xlsm » en maintenant le « s » en fin du mot « enregistrements » d’où les bugs sur toutes les lignes de code concernées :

Windows(« enregistrements devis.xlsm »).Activate
ligne = Workbooks(« enregistrements devis.xlsm »).Sheets(« bdd »).Range(« A2 »).End(xlDown).Row + 1
Workbooks(« enregistrements devis.xlsm »).Sheets(« bdd »).Range(« C » & ligne).Value = Workbooks(« formulaire devis AP.xlsm »).Sheets(« devis »).Range(« E4 »)
Workbooks(« enregistrements devis.xlsm »).Sheets(« bdd »).Range(« D » & ligne).Value = Workbooks(« formulaire devis AP.xlsm »).Sheets(« devis »).Range(« D37 »)
Workbooks(« enregistrements devis.xlsm »).Sheets(« bdd »).Range(« E » & ligne).Value = Workbooks(« formulaire devis AP.xlsm »).Sheets(« devis »).Range(« C8 »)
Workbooks(« enregistrements devis.xlsm »).Sheets(« bdd »).Range(« F » & ligne).Value = Workbooks(« formulaire devis AP.xlsm »).Sheets(« devis »).Range(« C11 »)
Workbooks(« enregistrements devis.xlsm »).Sheets(« bdd »).Range(« G » & ligne).Value = Workbooks(« formulaire devis AP.xlsm »).Sheets(« devis »).Range(« C9 »)
Workbooks(« enregistrements devis.xlsm »).Sheets(« bdd »).Range(« H » & ligne).Value = Workbooks(« formulaire devis AP.xlsm »).Sheets(« devis »).Range(« B14 »)
Workbooks(« enregistrements devis.xlsm »).Sheets(« bdd »).Range(« I » & ligne).Value = Workbooks(« formulaire devis AP.xlsm »).Sheets(« devis »).Range(« D27 »)
Windows(« enregistrements devis.xlsm »).Activate

Attention au nom de tes fichiers qui doivent correspondre au caractère prés et à la casse de ceux mentionnés dans tes lignes de code

J’ai dans cette partie déplacé une instruction :

Windows(« enregistrements devis.xlsm »).Activate
Sheets(« bdd »).Select
ActiveWorkbook.Save
ActiveSheet.Protect « titi », True, True, True
ActiveWorkbook.Close

il faut sauvegarder les fichiers aprés toutes modifications

Tu mets cette instruction de sauvegarde :

ActiveWorkbook.Save

avant cette modification du fichier :

ActiveSheet.Protect « titi », True, True, True

à sa fermeture demandée avec cette ligne :

ActiveWorkbook.Close

comme cette dernière modification n’a pas été enregistrée une confirmation d’enregistrement est demandé (boîte de dialogue)

Perte de temps inutile en remontant celle-ci avant la sauvegarde ainsi :

Windows(« enregistrements devis.xlsm »).Activate
Sheets(« bdd »).Select
ActiveSheet.Protect « titi », True, True, True
ActiveWorkbook.Save
ActiveWorkbook.Close

Et donc au final plus de confirmation à effectuer

Je te joins donc ton fichier corrigé mais attention aux noms te tes fichiers qui doivent être à l’exactitude de ceux cités dans tes lignes de code

Attention tu m’as transmis des fichiers avec un chiffre 1 en fin de dénomination
Ce 1 à suivi dans les lignes de code
Voir si il faut le maintenir en fonction des fichiers que tu ouvres

Pour te faciliter la tâche j’ai créé 2 variables définies en tout début de procédure :

docsource = « formulaire devis AP 1.xlsm »
docdesti = « enregistrement devis 1.xlsm »

Il suffit d’adapter simplement ces 2 lignes en fonction de l’évolution du nom des fichiers utilisés
Tout le reste du traitement utilise ces variables définies au départ

Fais des tests et dis moi

formulaire devis AP 1.xlsm (27,0 Ko)