Problème optimisation code VBA

Bonjour à tous,

Après avoir avancé sur un projet (merci à ddetp88 au passage), j'ai un dernier petit soucis qui doit relever de l'optimisation de mon code VBA.

Je vais essayer de vous expliquer rapidement : J'ai un userform qui me permet d'ajouter des lignes dans un tableau excel. Ces lignes sont ranger (et triées) automatiquement en fonction de ce qu'il est écrit en colonne N.

Tout fonctionne très bien, jusqu'au moment où j'ajoute 2 lignes de suite. La 2ème par en sucette total et mélange mes titres de catégories. Et tout seul, je ne trouve pas de solution

Vous trouverez ci-joint un exemple de mon fichier.

Quelqu'un voit d'où peut venir le problème ?

Merci pour votre aide

Bonjour Juju_ski

Je ne voudrais pas dire, mais c le b*rdel dans ton code

Mets un point d'arrêt (F9) dans ton USF à la procédure CmdbuttonValider_Click()

au niveau de la ligne

Ln = .Range(" B" & Rows.Count).End(xlUp).Row

Lance ton USF, rempli les informations et valide, le code va s'arrêter sur le point mis précédemment

Ensuite exécute ton code en pas à pas (F8) tu vas voir qu'il y a de drôles de choses qui se passent

A+

Merci Bruno pour ta réponse.

Oh oui dis donc ça part dans tous les sens

Il faudrait que je reprenne tout depuis le début ça cela ? Mon niveau ne me le permettra pas J'ai quelle autre option ?

Je ne comprends pas pourquoi mon code part dans tous les sens ... Je n'arrive pas à optimiser le code de manière à ce que tout s’enchaîne comme il faut

Bonjour Juju_ski

As-tu posté ta demande sur d'autres forum ?

A+

Bonjour Bruno,

Ah non, je n'utilise que celui-là

Je vais regarder ton fichier dans ce cas et voir ce que je peux faire

A+

C'est vraiment gentil. C'est pour ça que je reste sur ce forum, tout le monde est hyper sympathique.

Bonjour Juju_ski

Voilà ton fichier avec les modifications

Petite info, si tu définis ta feuille dans une variable objet

Set rf = Sheets("Recherche foncière")

Ca ne sert rien d'utiliser ensuite l'instruction With... End With

J'ai ajouté une ligne nommée "LigneACopier" dans ta feuille [Recherche foncière]

Cette ligne est copiée et insérer à chaque création via ton USF, comme ça tes MFC suivent

Testes et dis nous

Bonjour Bruno,

Merci d'avoir pris de ton temps pour m'aider.

J'ai testé le fichier. J'ai une petite erreur qui apparaît : une erreur d'exécution '1004' où la méthode select de la classe range a échoué, sur cette ligne de code :

rf.Cells(Ln, "B").Select

Par contre, une fois le mode VBA fermé, les lignes que j'ai rentré, malgré l'erreur d'exécution, ce sont quand même ajoutées et apparemment, sans problème majeur.

Je continue de tester pour voir s'il y aurait d'autre problème.

Re,

Peux-tu nous expliquer les manips que tu fais pour avoir l'erreur ?

A+

Oui alors, sur la page de garde, je fais ajouter un nouveau périmètre.

J'entre mes différentes données. Et c'est quand je valide l'userform que l'erreur d'exécution apparait

Edit. Par ailleurs, la ligne 5, ligne à copié. Je peux la mettre n'importe où dans mon fichier ? Où elle doit absolument être au dessus du tableau ?

Re,

Pour le périmètre, c'est bien ce que je faisais et il ne me semble pas avoir rencontré de soucis

Pour la ligne à copier, on peut effectivement la mettre en dessous du tableau, puisque la cellule B de la ligne est vide

A+

En supprimant la ligne de code en question, l'erreur disparaît et la ligne s'ajoute bien.

En revanche, l'écran reste sur la page de garde, et ne vas pas sélectionner la ligne ajouté pour me l'afficher (je ne sais pas si je suis clair )

Re,

juju_ski a écrit :

En supprimant la ligne de code en question, l'erreur disparaît et la ligne s'ajoute bien.

En revanche, l'écran reste sur la page de garde, et ne vas pas sélectionner la ligne ajouté pour me l'afficher (je ne sais pas si je suis clair )

Je ne pensais pas que tu avais besoin de sélectionner la ligne par la suite, voici le code de remplacement

Private Sub CmdbuttonValider_Click()
  Dim Ctrl As Control, ChampsManquants As String
  Dim Cel As Range
  'VERIFICATION DES SAISIES
  For Each Ctrl In Me.Controls
    If Ctrl.Tag = "Obligatoire" Then
      If Ctrl.Text = "" Then
        If ChampsManquants <> "" Then ChampsManquants = ChampsManquants & ", "
        ChampsManquants = ChampsManquants & Ctrl.Name
      End If
    End If
  Next Ctrl
  If ChampsManquants <> "" Then
    MsgBox "Les champs suivants sont nécessaires à l'application et n'ont pas été remplis:" & vbCrLf & ChampsManquants, vbOKOnly + vbInformation, "Champs manquants ou incorrects"
    Exit Sub
  End If
  ' Désactiver les évènements et le rafraichissement
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  ' Définir la feuille
  Set rf = Sheets("Recherche foncière")
  ' Activer la feuille sinon bug
  rf.Activate
  'AVERTIR DES DOUBLONS DE NUMERO DE PARCELLE
  '   If Application.CountIf(Columns("J"), "*" & Me.Txtnumparcelle.Value & "*") > 0 Then
  '   MsgBox "Un numéro de parcelle contenant le numéro " & Me.Txtnumparcelle.Value & " a déjà été enregistré."
  'End If
  'Dernière ligne du tableau
  Ln = rf.Range(" B" & Rows.Count).End(xlUp).Row
  '------------ Recherche la ligne où insérer les données ----------
  debplage = Application.Match(UCase(Me.CbbProcessus.Value), rf.[B:B], 0) + 1
  ' ------------- Trouve la fin de plage pour effectuer le tri --------------
  For Each Cel In rf.Range("B" & debplage & ":B" & Ln)
    If Cel.MergeCells = True Then
      ' Fin de plage
      finplage = Cel.Row
      ' Copier et insérer la ligne
      rf.Range("LigneACopier").Copy
      rf.Rows(finplage).Insert Shift:=xlDown
      rf.Rows(finplage).EntireRow.Hidden = False
      Call Ecriture
      Exit For
    ElseIf Cel.Row = Ln Then
      finplage = Ln + 1
      Call Ecriture
    End If
  Next Cel
  'TRI
  rf.Range("A" & debplage & ":U" & finplage).Sort Key1:=rf.[O10], Key2:=rf.[B10]
  ' repère la ligne en recherchant la croix
  Ln = Application.Match("x", rf.[A:A], 0)
  ' efface la croix
  rf.Cells(Ln, "A") = ""
  'selectionne la ligne
  rf.Cells(Ln, "B").Select
  ' Effacer la variable objet pour la mémoire
  Set rf = Nothing
  ' Fermer l'userform
  Unload Me
  ' Petit message
  MsgBox "Après le tri, le périmètre ajouté se trouve en ligne : " & Ln
  ' Réactiver les évènements et le rafraichissement
  Application.ScreenUpdating = True
  Application.EnableEvents = True
End Sub

A+

Merci Bruno. Ca marche parfaitement !

Finalement, juste en ajoutant :

Application.ScreenUpdating = False
  Application.EnableEvents = False

c'est bien ça ?

J'ai juste un dernier détail qui relève cette fois des MFC. En colonne B, j'ai mes MFC dans l'ordre couleur vert-->orange-->rouge-->bleu-->blanc. Or, quand j'ajoute un nouveau périmètre, l'ordre change et le bleu et le blanc passe devant le reste. Comment puis-je figer cela ?

Merci

Re,

juju_ski a écrit :

Merci Bruno. Ca marche parfaitement !

Finalement, juste en ajoutant :

Application.ScreenUpdating = False
  Application.EnableEvents = False

c'est bien ça ?

Non non, j'ai mis également

Rf.Activate

pour activer la feuille et ensuite pouvoir sélectionner la cellule

juju_ski a écrit :

J'ai juste un dernier détail qui relève cette fois des MFC. En colonne B, j'ai mes MFC dans l'ordre couleur vert-->orange-->rouge-->bleu-->blanc. Or, quand j'ajoute un nouveau périmètre, l'ordre change et le bleu et le blanc passe devant le reste. Comment puis-je figer cela ?

Si dans la cellule B de ta ligne "LigneACopier" la MFC est dans le bon sens, il n'y a pas de raison, je ne rencontre pas le pb chez moi

A+

Oui pourtant en colonne B de la ligne à copier, c'est dans le bon ordre.

Quand je vais dans le gestionnaire de mise en forme, j'obtiens ceci : cf. pièce jointe.

Et dans le même temps, comment cela ce fait-il que dans l'ordre, il y ai "court" --> "long" --> "moyen", et non pas par ordre alphabétique ?