Insertion de lignes selon le choix

bcharef

XLDnaute Accro
Bonsoir à toutes et à tous.

Je me trouve devant un problème dont la solution ne sera réalisée que par le VBA d'aprés mes connaissances.

Le problème s'explique comme suit:

La colonne C de l'exemple ci-joints porte sur des listes de validation.

Exemple :

En C26

Si, je dois faire le choix de plus d'une, je me retrouve dans l'obligation d'insérer une ligne en collant les données de la plage A26:D26, aprés confirmation de l'insertion.

En C28

Je me retrouve dans l'obligation d'insérer deux lignes portant les données de A28:D28, après confirmation une après une.

Le fichier ci-joint porte des éclaircissements ainsi que l'objectif recherché

Il est utile de porter à votre connaissance que je un ignare en matiére de VBA.

Salutations distinguées.

BCharef
 

Pièces jointes

  • InsertLignes.xls
    19.5 KB · Affichages: 74

JNP

XLDnaute Barbatruc
Re : Insertion de lignes selon le choix

Re :),
Je pense que c'est plutôt que tu as beaucoup de lignes, donc chaque insertion attend le recalcul..
Donc tu peux essayer
Code:
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Dim I As Integer, Ligne As Long
If Target.Column <> 4 Then Exit Sub
I = MsgBox("Voulez-vous insérer une ligne ?", vbOKCancel, "Insertion")
If I = vbCancel Then Exit Sub
[COLOR=red][B]Application.ScreenUpdating = False[/B][/COLOR]
Ligne = Target.Row + 1
With Sh
.Rows(Ligne).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
.Rows(Ligne - 1).Copy .Cells(Ligne, 1)
.Cells(Ligne, 6) = 0
.Cells(Ligne, 7) = 0
.Cells(Ligne, 8) = 0
.Cells(Ligne, 9) = 0
.Cells(Ligne, 10) = 0
.Cells(Ligne, 11) = 0
.Cells(Ligne, 12) = 0
Union(.Cells(Ligne, 4), .Cells(Ligne, 5)).ClearContents
Cancel = True
Target.Offset(1, 0).Select
End With
[COLOR=red][B]Application.ScreenUpdating = True[/B][/COLOR]
End Sub
Bon courage :cool:
 

bcharef

XLDnaute Accro
Re : Insertion de lignes selon le choix

Re bonjour JNP,
Re bonjour à toutes et à tous.

Effectivement, la feuil porte beaucoup de lignes, jusqu'à 300 lignes.

Il est utile de porter à votre connaissance, que je suis dans l'obligation de procéder au premier code.

Toujours, dans l'attente d'une amélioration du code.

Amicalement.

BCharef
 

JNP

XLDnaute Barbatruc
Re : Insertion de lignes selon le choix

Re :),
Il est utile de porter à votre connaissance, que je suis dans l'obligation de procéder au premier code.
Tu veux dire par là que mon dernier code ne marche pas :confused: ?
Sinon, il faudrait que tu poste un fichier plus près de celui que tu utilises, sans données confidentielles, pour qu'on puisse faire des tests. Tu as certainement des formules compliquées dans ton fichier, car 300 lignes ne devraient pas poser de problème de lenteur, si c'était 30 000 lignes, je comprendrait mieux :D.
A + :cool:
 

bcharef

XLDnaute Accro
Re : Insertion de lignes selon le choix

Bonjour JNP,
Bonjour à toutes et à tous.


Le code que vous m'aviez communiqué fonctionne, mais il est devenue plus lourd que le premier.

Effectivement, des formules compliquées sont utilisées dans mon classeur (composé de vingt feuilles) plus des TCDs.

Amicalement.

BCharef
 

JNP

XLDnaute Barbatruc
Re : Insertion de lignes selon le choix

Re :),
Peut-être avec
Code:
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Dim I As Integer, Ligne As Long
If Target.Column <> 4 Then Exit Sub
I = MsgBox("Voulez-vous insérer une ligne ?", vbOKCancel, "Insertion")
If I = vbCancel Then Exit Sub
Application.ScreenUpdating = False
[COLOR=red][B]Application.Calculation = xlCalculationManual
[/B][/COLOR]Ligne = Target.Row + 1
With Sh
.Rows(Ligne).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
.Rows(Ligne - 1).Copy .Cells(Ligne, 1)
.Cells(Ligne, 6) = 0
.Cells(Ligne, 7) = 0
.Cells(Ligne, 8) = 0
.Cells(Ligne, 9) = 0
.Cells(Ligne, 10) = 0
.Cells(Ligne, 11) = 0
.Cells(Ligne, 12) = 0
Union(.Cells(Ligne, 4), .Cells(Ligne, 5)).ClearContents
Cancel = True
Target.Offset(1, 0).Select
End With
[COLOR=red][B]Application.Calculation = xlCalculationAutomatic
[/B][/COLOR]Application.ScreenUpdating = True
End Sub
qui va arrêter les calculs le temps de l'insertion :rolleyes:.
A + :cool:
 

bcharef

XLDnaute Accro
Re : Insertion de lignes selon le choix

Re bonjour JNP,
Re bonjour à toutes et à tous.

C'est parfait, sincèrement, j'attendais toujours l'amélioration du code.

Merci, encore pour le temps et la réflexion que vous m'aviez accordé.

Amicalement.

BCharef
 

bcharef

XLDnaute Accro
Re : Insertion de lignes selon le choix

Re bonjour JNP,
Re bonjour à toutes et à tous.

Voulez-vous bien me conseiller sur le problème suivant portant toujours sur l'utilité du même code.

Mon classeur contient 20 feuilles, dont quelques feuilles, je ne serais pas dans l'obligation l'usage du code d'une part et d'autre part quelques feuilles n'ont pas la même structure.

A cet, effet, je serais dans l'obligation:
  • Insérer le code dans chaque feuille, on portant les modifications necessaires;
ou bien
  • Insérer le code dans ThisWorkBook et d'organiser la structure de chaque feuille, dans ce cas, comment empêcher l'exécution du code pour les feuilles de calcul, dont je ne dois pas utiliser le code.

Comment procéder ?

Amicalement.

BCharef
 
Dernière édition:

bcharef

XLDnaute Accro
Re : Insertion de lignes selon le choix

Re bonjour JNP,
Re bonjour à toutes et à tous.

Dois-je écrire le code dans ThisWorkBook ?

Mais,comment faire le code pour plus de deux feuilles, ainsi que les feuilles dans la structure est différente ?

Mais si, je serais dans l'obligation d'uniformiser les feuilles ou bien de coller le code dans chaque feuille.

Amicalement.

BCharef
 

JNP

XLDnaute Barbatruc
Re : Insertion de lignes selon le choix

Re :),
Mais,comment faire le code pour plus de deux feuilles, ainsi que les feuilles dans la structure est différente ?

Mais si, je serais dans l'obligation d'uniformiser les feuilles ou bien de coller le code dans chaque feuille.
Si la structure est différentes pour les feuilles, 2 solutions :
1) Coller le code dans chaque feuille, en repartant du code de mon premier fichier, car il n'y aura pas de Sh envoyé par le code. L'adapter à chaque structure de feuille.
2) La structure modifiant logiquement uniquement la partie pour mettre les 0 et vider le contenu, mettre un test dans le code général
Code:
With Sh
.Rows(Ligne).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
.Rows(Ligne - 1).Copy .Cells(Ligne, 1)
[COLOR=red][B]Select Case .Name[/B][/COLOR]
[B][COLOR=red]Case "Feuil1", "Feuil2"[/COLOR][/B]
.Cells(Ligne, 6) = 0
.Cells(Ligne, 7) = 0
.Cells(Ligne, 8) = 0
.Cells(Ligne, 9) = 0
.Cells(Ligne, 10) = 0
.Cells(Ligne, 11) = 0
.Cells(Ligne, 12) = 0
Union(.Cells(Ligne, 4), .Cells(Ligne, 5)).ClearContents
[COLOR=red][B]Case "Feuil3"[/B][/COLOR]
.Cells(Ligne, 3) = 0
Union(.Cells(Ligne, 2), .Cells(Ligne, 6)).ClearContents
'...
[COLOR=red][B]Case Else[/B][/COLOR]
'...
[COLOR=red][B]End Select[/B][/COLOR]
Cancel = True
Target.Offset(1, 0).Select
End With
Bon courage :cool:
 

bcharef

XLDnaute Accro
Re : Insertion de lignes selon le choix

Bonjour JNP,
Bonjour à toutes et à tous.

Encore une fois, j'ai le plaisir de vous remercier à l'importance que vous m'accordiez.

Il est à noter, que j'ai procédé à l'uniformisation de structure des feuilles concernées par le code pour cinq classeurs à titre d'information.

J'ai copié le code ci-après dans ThisWorkBook.

Code:
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Dim I As Integer, Ligne As Long
If Target.Column <> 6 Then Exit Sub
I = MsgBox("Voulez-vous insérer une ligne ?", vbOKCancel, "Insertion")
If I = vbCancel Then Exit Sub
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Ligne = Target.Row + 1
With Sh
.Rows(Ligne).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
.Rows(Ligne - 1).Copy .Cells(Ligne, 1)
.Cells(Ligne, 9) = 0
.Cells(Ligne, 10) = 0
.Cells(Ligne, 11) = 0
.Cells(Ligne, 12) = 0
.Cells(Ligne, 13) = 0
.Cells(Ligne, 14) = 0
.Cells(Ligne, 15) = 0
Union(.Cells(Ligne, 4), .Cells(Ligne, 6), .Cells(Ligne, 7)).ClearContents
Cancel = True
Target.Offset(1, 0).Select
End With
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Et ça marche convenablement, sauf pour quelques feuilles, dont le nombre de lignes ne dépassent pas 100, mais l'existance de formules compliquées.

Amicalement.

BCharef
 

Statistiques des forums

Discussions
311 725
Messages
2 081 947
Membres
101 849
dernier inscrit
florentMIG