Validation de formulaire lent

Question

Tout d'abbord merci beaucoup pour vos discussions, je suis débutant dans vba et grâce à vos sujet j'ai pu créer qlq petits programmes. Cependant je rencontre un petit problème. J'ai créer un formulaire pour mon entreprise, et au moment ou la personne valide le formulaire à l'aide d'un boutton click, les données du userform sont envoyer sur une autre feuille dans des cellules spécifiques. Puis ensuite un envoi par mail du fichier est effectué. Mais cette action prend plus d'une minute, pouvez-vous me dire si ce problème viens de mon code svp? Private Sub Validation_Click() Dim rng As Range Dim i As Integer ' Contrôle des données saisies If TRANSPORTEUR = "" Then MsgBox "Nom du transporteur obligatoire", vbExclamation, strAppeName Exit Sub End If If Not (Avec Or Sans) Then MsgBox "Renseignement sur les accessoires obligatoire", vbExclamation, strAppeName Exit Sub End If If lstDemandeur = "" Then MsgBox "Nom du demandeur obligatoire", vbExclamation, strAppeName Exit Sub End If If Client = "" Then MsgBox "Nom du Client obligatoire", vbExclamation, strAppeName Exit Sub End If If demonstrateur = "" Then MsgBox "Nom du démonstrateur obligatoire", vbExclamation, strAppeName Exit Sub End If 'Adresse de livraison If txtContact_destinataire = "" Then MsgBox "Nom du contact destinataire obligatoire", vbExclamation, strAppeName Exit Sub End If If txtTéléphone_destinataire = "" Then MsgBox "Numéro du contact destinataire obligatoire", vbExclamation, strAppeName Exit Sub End If If txtAdresse_de_déchargement = "" Then MsgBox "Adresse de déchargement obligatoire", vbExclamation, strAppeName Exit Sub End If If txtSociété_destinataire = "" Then MsgBox "Nom de la Société destinataire obligatoire (client...)", vbExclamation, strAppeName Exit Sub End If If Not (Oui Or Non) Then MsgBox "Renseignement sur la présence de quai à l'adresse de livraison obligatoire", vbExclamation, strAppeName Exit Sub End If If Ville_destinataire = "" Then MsgBox "Ville de livraison obligatoire", vbExclamation, strAppeName Exit Sub End If If CP_destinataire = "" Then MsgBox "Code Postal de l'adresse de livraison obligatoire", vbExclamation, strAppeName Exit Sub End If ' Enregistrement Base de donnée Dim dest As Workbook Sheets("Demandes").Activate Range("C3").Value = CDate(DateDemande) Range("D3").Value = lstDemandeur Range("E3").Value = "" 'Location Range("F3").Value = "" 'Prêt SAV Range("G3").Value = "" 'FDC Range("H3").Value = "" 'Backlog Range("I3").Value = "" 'Stockage Range("J3").Value = "" 'Reprise machine Range("K3").Value = "" 'Vente Range("L3").Value = "VRAI" 'Démo Range("M3").Value = "" 'Transfert client Range("N3").Value = Machine Range("O3").Value = Config Range("P3").Value = SN Range("Q3").Value = Avec ' Accessoires Range("R3").Value = Sans ' Accessoires Range("S3").Value = txtAdresse_de_chargement Range("T3").Value = Rue_expéditeur Range("U3").Value = Ville Range("V3").Value = CP Range("W3").Value = txtSociété_expéditrice Range("X3").Value = txtContact_expéditeur Range("Y3").Value = txtTéléphone_expéditeur Range("Z3").Value = Oui1 ' Quai chargement Range("AA3").Value = Non1 ' Quai chargement Range("AB3").Value = txtAdresse_de_déchargement Range("AC3").Value = Rue_destinataire Range("AD3").Value = Ville_destinataire Range("AE3").Value = CP_destinataire Range("AF3").Value = txtSociété_destinataire Range("AG3").Value = txtContact_destinataire Range("AH3").Value = txtTéléphone_destinataire Range("AI3").Value = Oui ' Quai déchargement Range("AJ3").Value = Non ' Quai déchargement Range("AK3").Value = CDate(livraison) Range("AL3").Value = CDate(livraison) Range("AM3").Value = Txtcommentaire Range("AN3").Value = Client Range("AO3").Value = lstDémonStrateur Range("AP3").Value = "" Range("AQ3").Value = Heures Range("AR3").Value = heure Range("AS3").Value = "" Range("AT3").Value = "" Range("AU3").Value = "" Range("AV3").Value = TRANSPORTEUR ' Enregistrement Liste pour création DMM Worksheets("Demande de tarif").Visible = 1 Worksheets("DMM").Visible = 1 Sheets("DMM").Activate ' Sauvegarde de la page ActiveWorkbook.Save ' Envoie de la demande par mail Dim appOutlook As Outlook.Application Dim oMail As Outlook.MailItem ' Lance une session Outlook Set appOutlook = CreateObject("outlook.application") ' Crée un nouveau mail Set oMail = appOutlook.CreateItem(olMailItem) With oMail ' Titre, Texte, Destinataires, Pièces jointes du message .Subject = "Demande de démo" .Body = "Veuillez trouver en pièce jointe ma demande de mouvement pour une démo" .BodyFormat = olFormatHTML .Recipients.Add ("adresse@mail.com") .Attachments.Add ActiveWorkbook.Path &amp; "\" &amp; ActiveWorkbook.Name ' Envoie le message .Send End With ' Réinitialise l'objet Set appOutlook = Nothing 'Ferme les DMM Worksheets("Demande de tarif").Visible = 0 Worksheets("DMM").Visible = 0 ' Remise à zéro des cases à cocher Dim Ctrl As Control, TheNum As Byte For Each Ctrl In Me.Controls If TypeOf Ctrl Is MSForms.CheckBox Then With Ctrl .Value = False End With End If Next Ctrl ' Remise à zéro des Liste et textBox Dim c As Control For Each c In Me.Controls Select Case TypeName(c) Case "TextBox" c.Value = "" Case "CheckBox" c.Value = False Case "ListBox", "ComboBox" c.ListIndex = -1 End Select Next c ' Sauvegarde de la page ActiveWorkbook.Save 'Initialise la date DateDemande = Format(Now, "dd/mm/yyyy") End Sub Merci de votre aide...

Benead · Accepted Answer

As-tu bien mis Application.ScreenUpdating=false avant de commencer à mettre à jour les cellules ? Sinon essaie ces trois lignes : Private Sub Validation_Click() Dim rng As Range Dim i As Integer Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.EnableEvents = False ' Code... ' En fin de Sub ' Sauvegarde de la page ActiveWorkbook.Save 'Initialise la date DateDemande = Format(Now, "dd/mm/yyyy") Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Application.EnableEvents = True End Sub Mais mets bien les lignes en début et en fin de code...

Benead · Answer

Cela ne fera pas gagner de temps, mais pour info, il est inutile d'activer un feuille pour l'utiliser : With Sheets("Demandes") .Range("C3").Value = CDate(DateDemande) .Range("D3").Value = lstDemandeur .Range("E3").Value = "" 'Location .Range("F3").Value = "" 'Prêt SAV With Tu vas gagner beaucoup de temps en utilisant Application.ScreenUpdating pour figer l'écran avant de mettre à jour les cellules : Application.ScreenUpdating = False ' Màj des cellules Application.ScreenUpdating=True Il faut essayer sur un autre ordinateur pour voir les différences de temps (cela peut venir de l'ordinateur). Il faut essayer de voir quelle partie du code mets beaucoup de temps (màj des cellules, Outlook, sauvegarde... ?) Reviens vers nous si ta macro est toujours longue à s'exécuter...