Incrémentation de lignes auto avec nombre de cellules limité

Bonjour le forum,

J'avais clôt un sujet la semaine passée, "Incrémentation d'un tableau en fonction des données collées" car la solution apportée par Banzai64 me convenait très bien. Même après personnalisation, tout me semblait correct.

Oui, mais .... en voulant ajouter des boutons de macros dans des colonnes à droite de mon tableau, je me suis rendu compte que lors de la suppression automatique de lignes (quand données supprimées des colonnes B et E), mes boutons de macro disparaissent en même temps que mes lignes. J'ai essayé en vain de modifier le code, en mettant une notion de variable "plage" plutôt que "lig", mais ça ne fonctionne pas.

En résumé, il faudrait que les actions auto d'ajout et de suppression de lignes soient en fait des ajouts de plages de cellules par lignes, n'allant que des colonnes A à I. Ci-dessous le code d'origine que j'essaie de modifier :

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Dim Lig As Long

  If Not Application.Intersect(Target, Range("A4:I65536")) Is Nothing Then
  ' Si la saisie est faite sur les cellules des colonnes 2 (B) ou 5 (E)
    With Application
      .ScreenUpdating = False
      .EnableEvents = False
    End With
    Debug.Print Target.Row, Target.Rows.Count
    For Lig = Target.Row + Target.Rows.Count - 1 To Target.Row Step -1
      If Range("B" & Lig) <> "" Or Range("E" & Lig) <> "" Then
        Range("A" & Lig & ":I" & Lig).Borders.LineStyle = xlContinuous
        Range("A" & Lig & ":I" & Lig).HorizontalAlignment = xlCenter
        Range("A" & Lig & ":I" & Lig).VerticalAlignment = xlCenter

        If Range("E" & Lig).Value <> "" Then
        Range("E" & Lig).Value = Range("E" & Lig) * 1
        With Selection
                .NumberFormat = "#,##0.000"
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
        End With
        End If
      ElseIf Range("B" & Lig) = "" And Range("E" & Lig) = "" Then
        Rows(Lig).Delete
      End If
    Next Lig
    Lig = Columns("A:I").Find(what:="*", searchdirection:=xlPrevious, SearchOrder:=xlByRows).Row + 1
    Range("A" & Lig & ":I" & Lig).Borders.LineStyle = xlContinuous
    Application.EnableEvents = True
  End If
End Sub

Merci d'avance pour votre aide ...

Philippe

Petite info supplémentaire : j'ai essayé par exemple, sous ma condition "ElseIf", de remplacer le code par ceci :

ElseIf Range("B" & Lig) = "" And Range("E" & Lig) = "" Then
             Rows(Lig).Range("A" & Lig & ":I" & Lig).Delete
             Rows(Lig).Range("A" & Lig & ":I" & Lig).Borders.LineStyle = xlNone

.... mais le problème est qu'après insertion, par exemple, de plusieurs nombre en colonne E, dès qu'on les supprime, les bordures des 3 dernières lignes subsistent !

Si tu es dans le coin, Banzai64, peut être préférerais tu avoir mon fichier Excel complet ?

Comment puis je te l'envoyer ?

Merci d'avance ...

Bonjour

remplaces la ligne surlignée par la ligne surlignée

      ElseIf Range("B" & Lig) = "" And Range("E" & Lig) = "" Then
        [surligner=#FFFF80]'Rows(Lig).Delete
        ' Que la zone de la colonne A à la colonne I sera supprimée
        Range("A" & Lig & ":I" & Lig).Delete shift:=xlShiftUp
      End If
    Next Lig

Tu peux supprimer la ligne suivante (utilisée pour le débogage)

Debug.Print Target.Row, Target.Rows.Count

Merci pour ta suggestion Banzai64, cela devrait le faire. J'ai oublié au taf ma clé USB contenant le fichier Excel.

Je l'essaierais demain et te posterais mes résultats.

En effet, Bonzai64, ça fonctionne à merveille ...

J'ai également ajouté quelques lignes de code afin de récupérer le nom du feuillet créé afin de l'afficher en temps que "date" dans la cellule G1 de la feuille. Ca fonctionne avec ceci :

NomOnglet = ActiveSheet.Name

Range("G1").Value = NomOnglet

Range("G1") = CDate(Range("G1"))

With Range("G1")

.HorizontalAlignment = xlCenter

.VerticalAlignment = xlCenter

.NumberFormat = "[$-F800]dddd, mmmm dd, yyyy"

.Font.Name = "Comic Sans MS"

.Font.FontStyle = "Italique"

.Font.Size = 14

.Font.ColorIndex = 3

.Interior.ColorIndex = 40

.Borders.LineStyle = xlContinuous

.Borders.Weight = xlMedium

... mais le problème est que si le nom de l'onglet est modifié, la date en G1 reste figée. Il faudrait peut être que je mette ces lignes de code dans une "function" afin d'y faire appel dans mon "Private Sub Worksheet_Change(ByVal Target As Range)".

Qu'en penses-tu ?

Et enfin, pour en finir avec mon userform et la saisie des dates, j''essaie d'intégrer quelques lignes supplémentaires permettant d'afficher un MsgBox au cas ou le choix utilisateur serait invalide (du type 31 avril ...), sans succès pour l'instant.

Je me suis orienté vers un code du genre :

NomOnglet = ActiveSheet.Name

NomOnglet = CDate(NomOnglet)

If Not (IsDate(NomOnglet).Value)) Then

MsgBox "Date invalide"

End If

Mais ça ne marche pas ... Une idée pour ces deux petits problèmes ?

Bonjour

Je dois m'absenter mais impératif il faut ton fichier actuel

car

Filomene a écrit :

récupérer le nom du feuillet créé afin de l'afficher en temps que "date"

A suivre

Je dois m'absenter aussi. Mais pas de problème, je t'enverrais mon fichier complet ce soir, avec les différentes explications sur ce que j'attends de ce fichier.

Merci encore pour ton aide ... :

Bonsoir Bonzai64,

Comme promis, je te joins mon fichier ...

Le truc que je cherche à faire maintenant (en dehors de chercher les bugs possibles lors de la saisie par les utilisateurs) c'est d'envoyer un MsgBox d'erreur si la date choisie par le userform n'existe pas (genre 30 février). Sans compter l'affichage en cellule G1 non dynamique si le nom de l'onglet de prod est changé par l'utilisateur (car il a des imports des cette cellule plus tard).

Si tu as toujours un peu de courage pour m'aider, je touche presque au but ...

Bonsoir

Avec le mot de passe cela serait plus facile

Je te l'ai envoyé par mail ...

Bonjour,

Je pense avoir trouver comment faire pour mettre à jour le cellule "G1" d'une feuille donc l'utilisateur pourrait demander le renommage, et ceci sans ralentir l'exécution du fichier. Je vais me baser sur "Application.CommandBars.FindControls" lors de l'utilisation du menu contextuel afin qu'un userform se lance. Je pourrais alors (avant modification), enregistrer le nom de feuille au moment, et lancer, après renommage, une macro sous "Worksheet_Change(ByVal Target As Range)" qui permettra de changer la valeur de la cellule.

Je sais que tu ne vois pas l'intérêt de ce que je veux faire, mais je le fait uniquement parce le fichier de base est ancien (avant que j'arrive à mon poste) et que les utilisateurs se basent par habitude à cette cellule qui affiche clairement (en rouge) la date finale de production qui n'est pas a dépasser. Si je peux donc le faire sans surcharger le découlement de l'application. Je te ferais savoir si j'ai réussi ...

Au fait, bravo pour la détection d'un choix de date incohérent par le userform, il marche parfaitement.