Microsoft 365 VBA - Enregistrement des valeurs TextBox dans mes cellules Excel

[Antoine C.]

Ma procédure de Sauvegarde (reporter le contenu de mes TextBox dans mes cellules) me semble longue, auriez-vous plus rapide ?
A savoir qu'avoir ajouté le If à fait accélérer les choses...

'********** Processus de Sauvegarde **********
Private Sub SaveProcess()
Application.ScreenUpdating = False
Application.Cursor = xlWait

    Dim SaveMessage As String
    Dim NumLigne As Variant
    NumLigne = Me.txtNumLigne.Value
      
'Enregistrements
    If Feuil1.Cells(NumLigne, 6) <> frmSaisie.txtNom Then
        Feuil1.Cells(NumLigne, 6) = frmSaisie.txtNom
        SaveMessage = "Nom, "
        End If
        
    If Feuil1.Cells(NumLigne, 7) <> frmSaisie.txtPrenom Then
        Feuil1.Cells(NumLigne, 7) = frmSaisie.txtPrenom
        SaveMessage = SaveMessage & "Prénom, "
        End If
 
    If Feuil1.Cells(NumLigne, 8) <> frmSaisie.txtAdresse1 Then
        Feuil1.Cells(NumLigne, 8) = frmSaisie.txtAdresse1
        SaveMessage = SaveMessage & "Adresse, "
        End If

    If Feuil1.Cells(NumLigne, 9) <> frmSaisie.txtAdresse2 Then
        Feuil1.Cells(NumLigne, 9) = frmSaisie.txtAdresse2
        SaveMessage = SaveMessage & "Adresse 2, "
        End If

    If Feuil1.Cells(NumLigne, 11) <> frmSaisie.txtVille Then
        Feuil1.Cells(NumLigne, 11) = frmSaisie.txtVille
        SaveMessage = SaveMessage & "Ville, "
        End If


    If Feuil1.Cells(NumLigne, 12) <> Val(frmSaisie.txtTel1) Then
        Feuil1.Cells(NumLigne, 12) = Val(frmSaisie.txtTel1)
        SaveMessage = SaveMessage & "Tel 1, "
        End If


    If Feuil1.Cells(NumLigne, 14) <> Val(frmSaisie.txtTel2) Then
        Feuil1.Cells(NumLigne, 14) = Val(frmSaisie.txtTel2)
        SaveMessage = SaveMessage & "Tel 2, "
        End If


    If Feuil1.Cells(NumLigne, 16) <> frmSaisie.txtEmail Then
        Feuil1.Cells(NumLigne, 16) = frmSaisie.txtEmail
        SaveMessage = SaveMessage & "Email, "
        End If


    If Feuil1.Cells(NumLigne, 2).Text <> frmSaisie.cboSource.Value Then
        Feuil1.Cells(NumLigne, 2) = frmSaisie.cboSource.Value
        SaveMessage = SaveMessage & "Source, "
        End If


    If Feuil1.Cells(NumLigne, 17) <> frmSaisie.txtDateContact.Text Then
        Feuil1.Cells(NumLigne, 17).Value = CDate(frmSaisie.txtDateContact.Value)
        SaveMessage = SaveMessage & "Date Contact, "
        End If

'Verifie les cellules
    If Feuil1.Cells(NumLigne, 54) <> frmSaisie.txtClientRFR.Text Then
       Feuil1.Cells(NumLigne, 54) = frmSaisie.txtClientRFR.Value
       'SaveMessage = SaveMessage & "RFR, "
       End If

    If Feuil1.Cells(NumLigne, 55) <> frmSaisie.txtClientRFRnb.Text Then
       Feuil1.Cells(NumLigne, 55) = frmSaisie.txtClientRFRnb.Value
       'SaveMessage = SaveMessage & "RFR NB, "
       End If
  
    If frmSaisie.txtRdvDate = "" Then
        Feuil1.Cells(NumLigne, 18).Value = ""
        Else
    If Feuil1.Cells(NumLigne, 18) <> frmSaisie.txtRdvDate.Text Then
        Feuil1.Cells(NumLigne, 18).Value = CDate(frmSaisie.txtRdvDate.Value)
        SaveMessage = SaveMessage & "Date RDV, "
        End If
        End If

    If Feuil1.Cells(NumLigne, 19) <> frmSaisie.txtRdvHeure Then
        Feuil1.Cells(NumLigne, 19) = frmSaisie.txtRdvHeure
        SaveMessage = SaveMessage & "Heure RDV, "
        End If

        If frmSaisie.CBRdvMailEnvoye.Value = True Then
        Feuil1.Cells(NumLigne, 20).Value = "X"
        End If
        If frmSaisie.CBRdvMailEnvoye.Value = False Then
        Feuil1.Cells(NumLigne, 20).Value = ""
            If frmSaisie.txtRdvDate <> "" Then
            End If
        End If
        
        If frmSaisie.cbrOutlookOk.Value = True Then
        Feuil1.Cells(NumLigne, 68).Value = "X"
        End If
        If frmSaisie.cbrOutlookOk.Value = False Then
        Feuil1.Cells(NumLigne, 68).Value = ""
        End If
        
        If frmSaisie.cbrSmsOk.Value = True Then
        Feuil1.Cells(NumLigne, 67).Value = "X"
        End If
        If frmSaisie.cbrSmsOk.Value = False Then
        Feuil1.Cells(NumLigne, 67).Value = ""
        End If
        
    If Feuil1.Cells(NumLigne, 33) <> frmSaisie.cboProjetType Then
        Feuil1.Cells(NumLigne, 33) = frmSaisie.cboProjetType
        SaveMessage = SaveMessage & "Projet, "
        End If

    If Feuil1.Cells(NumLigne, 34) <> frmSaisie.cboProjetSousType Then
        Feuil1.Cells(NumLigne, 34) = frmSaisie.cboProjetSousType
        End If

    If Feuil1.Cells(NumLigne, 35) <> frmSaisie.txtComplement Then
        Feuil1.Cells(NumLigne, 35) = frmSaisie.txtComplement
        End If

    If Feuil1.Cells(NumLigne, 21) <> frmSaisie.txtDevisDate.Text Then
        Feuil1.Cells(NumLigne, 21).Value = CDate(frmSaisie.txtDevisDate.Value)
        SaveMessage = SaveMessage & "Date Devis, "
        End If

    If Feuil1.Cells(NumLigne, 22) <> frmSaisie.txtDevisDatePresentation.Text Then
        If frmSaisie.txtDevisDatePresentation = "" Then
        Feuil1.Cells(NumLigne, 22).Value = ""
        SaveMessage = SaveMessage & "Date Remise, "

        Else
        Feuil1.Cells(NumLigne, 22).Value = CDate(frmSaisie.txtDevisDatePresentation.Value)
        SaveMessage = SaveMessage & "Date Remise, "
        End If
        End If
    
    If Feuil1.Cells(NumLigne, 62) <> frmSaisie.cboMoyenDeRemise Then
        Feuil1.Cells(NumLigne, 62) = frmSaisie.cboMoyenDeRemise
        End If

    If Feuil1.Cells(NumLigne, 23) <> frmSaisie.txtDevisMontant.Text Then
        Feuil1.Cells(NumLigne, 23) = Val(frmSaisie.txtDevisMontant)
        SaveMessage = SaveMessage & "Montant Devis, "
        End If
        
    If Feuil1.Cells(NumLigne, 63) <> Me.txtNoteTilkee.Text Then
       Feuil1.Cells(NumLigne, 63) = Val(Me.txtNoteTilkee)
       End If

    If Feuil1.Cells(NumLigne, 31) <> frmSaisie.txtDateReponse.Text Then
        If frmSaisie.txtDateReponse = "" Then
        Feuil1.Cells(NumLigne, 31).Value = ""
        SaveMessage = SaveMessage & "Date Réponse, "

        Else
        Feuil1.Cells(NumLigne, 31).Value = CDate(frmSaisie.txtDateReponse.Value)
        SaveMessage = SaveMessage & "Date Réponse, "
        End If
        End If

    If Feuil1.Cells(NumLigne, 5) <> frmSaisie.cboStatutFinal.Value Then
        Feuil1.Cells(NumLigne, 5) = frmSaisie.cboStatutFinal
        SaveMessage = SaveMessage & "Statut Final : " & frmSaisie.cboStatutFinal.Value & ", "
        End If
    
    If Feuil1.Cells(NumLigne, 36) <> frmSaisie.txtDevisInfos.Text Then
        Feuil1.Cells(NumLigne, 36) = frmSaisie.txtDevisInfos.Text
        SaveMessage = SaveMessage & "Le Suivi"
        End If
                
'MAJ DU SUIVI CLIENT ET DE L'HISTORIQUE
If SaveMessage <> "" Then
    frmSaisie.txtDevisInfosEnr.Value = Feuil4.Range("H54").Value & " | " & Utilisateur & " | " & Date & " à " & Format(Now, "hh:mm") & ", modification(s) : " & SaveMessage & vbCrLf & Me.txtDevisInfosEnr.Value
    frmSaisie.txtHistorique.Value = Me.txtNom & " " & Me.txtPrenom & " | " & Utilisateur & " | " & Date & ": " & SaveMessage & vbCrLf & Me.txtHistorique.Value
End If
    
'MAJ DU SUIVI ENREGISTREMENT CLIENT
    If Feuil1.Cells(NumLigne, 69) <> frmSaisie.txtDevisInfosEnr.Text Then
        Feuil1.Cells(NumLigne, 69) = frmSaisie.txtDevisInfosEnr.Text
        End If

Application.ScreenUpdating = True
Application.Cursor = xlDefault
End Sub

Merci pour votre aide !

 

[tomocam]

Bonjour Antoine,

A première vue il semble possible de simplifier la macro en utilisant des boucles for ou do.
Avez-vous un fichier d'exemple à nous partager qui permettrait de comprendre le contexte ?

Tomo

 

[Antoine C.]

Bonjour Tomo,

Je vais essayer d'extraire la partie spécifique de mon fichier pour vous la transmettre.
Il contient pas mal d'informations confidentielles, et le fichier finalisé représente lui aussi pas mal d'heures de travail.
A très vite.

Antoine