VBA : insérer une ligne
____A____B_____C_________D_______E______F
1____________Thème____Chrone
2______________1.
3______________1._________1
4______________1._________2
5______________1._________3
6______________1._________4
7______________1._________5
8______________1._________7
9______________1._________8
10_____________2.
11_____________2._________1
12_____________2._________2
13_____________2._________3
14_____________..._________...
Lorsque j'insère une ligne (par exemple en 5), je voudrais que le code cherche le premier Chrono disponible dans le thème 1. (ici 6)
voici mon code :
Sub AjouterLigne()
'
' Ajouter Macro
'
NmLigne = Selection.Row 'NmLigne = N∞ de la ligne selectionnÈe
ValLigneThem = ActiveSheet.Cells(NmLigne, 3).Formula '"1." ou "2." ou "3." ...
ValLigneChro = ActiveSheet.Cells(NmLigne, 4).Formula '"1" ou "2" ou "3" ou "4" ...
ActiveSheet.Rows(ActiveCell.Row).EntireRow.Select 'On selectionne la ligne de la cellule active
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 'on rajoute une ligne
i = 0
NmL = NmLigne
Do While ActiveSheet.Cells(NmL - 1, 3).Formula = ValLigneThem ' on compte le nombre
i = i + 1 'd'ÈlÈments du meme theme avant la nvlle ligne
NmL = NmL - 1
Loop
j = 0
NmL = NmLigne
Do While ValLigneThem = ActiveSheet.Cells(NmL + 1, 3).Formula ' on compte le nombre
j = j + 1 'd'elements du meme theme apres la nvelle ligne
NmL = NmL + 1
Loop
TailleTheme = i + j + 1
ValLigneThem = ActiveSheet.Cells(NmLigne).Formula
PremierTheme = NmL - i
For k = 1 To TailleTheme ' k commence à 1 car le premier terme
If ActiveSheet.Cells(PremierTheme + k, 4) <> k Then ' de chaque thème est " "
ValLigneChrono = k
End If
Next k
End SubMerci beaucoup de vous y pencher
Cdlt, Sym.
Bonjour
Questions:
Les Thèmes sont-ils toujours groupés ?
Les Chronos sont-il toujours dans l'ordre ?
Que faire si pas de numéro disponible ?
A te lire
Bonne nuit
Bonjour!
Tout d'abord, merci de vous pencher sur mon cas!
Sinon les Thèmes sont en effet toujours groupés et les Chrono pas forcément dans l'ordre, dans mon exemple, j'avais imaginé placer le Chrono 6 à la fin du thème 1 mais, après mure réflexion, je pense que ma macro SupprimerLigne (pas montrée ici) ne supprimera plus la ligne active mais la dernière ligne du meme thème que celui de la ligne active...
Dans mon exemple, on peut imaginer que l'utilisateur a supprimé la Ligne du chrono 6. Après modification de la macro, en sélectionnant une cellule de la ligne du chrono 6, la macro aurait enfait supprimé le chrono 8 (toujours du thème 1).
AjouterLigne aurait donc dû ajouter le Chrono 8 puis 9 et ainsi de suite... À la fin du thème 1 mais avant le thème 2...
Je ne suis pas sûre de bien comprendre votre question
-Que ce passe t-il s'il n'y a pas de Num dispo?!
Je pense juste, que dans ce cas, il cré le numéro (par exemple 9?)
Encore merci
Cdlt Sym.
-- 04 Juil 2011, 11:15 --
Re-Bonjour à tous!
J'ai réussi à modifier mes macros SupprimerLigne et AjouterLigne pour qu'elles ne touchent que la dernière ligne du thème concerné. Je vois donnerais le fichier ce soir.
Il me reste cependant un petit gag :
À un moment, la macro AjouterLigne ajoute une ligne et la complète ;
Pour compléter la colonne de thèmes, j'ai cette formule :
ActiveSheet.Cells(NumLigneFin, 3).Formula = ActiveSheet.cells(NumLigne, 3).Formula
Il me met bien le numéro de chrono mais pas le point. Et si je fais :
ActiveSheet.Cells(NumLigneFin, 3).Formula = ActiveSheet.cells(NumLigne, 3).Formula & "."
Là il passe directement à deux points puis 3, 4, 5...
Savez vous comment faire?
Bonsoir!
Non ce n'est pas tout à fait çà que je cherchais..
Après avoir modifié ma maccro SupprimerLigne, je n'ai plus eut besoin de "remplir les trou" mais <<simplement>> de rajouter un N° Chrono à chaque fois qu'on actionnait la maccro. Voici la partie principale de la maccro (d'après mes souvenirs...)
Signalez le moi si çà ne marche pas, je penserais à ramener le fichier...
Sub AjouterLigne()
'
' Ajouter Macro
'
NumLigne = Selection.Row
Dim ValeLigneFin As Integer
Dim i As Integer
Do While ActiveSheet.Cells(NumLigne, 3).Formula = ActiveSheet.Cells(NumLigne + i, 3).Formula '3 : Thèmes
If ActiveSheet.Cells(NumLigneFin, 5) = " " '5 : Chronos
ValeLigneFin = 0 '4 : "."
Else
i = i + 1
NumLigneFin = NumLigne + i
ValeLigneFin = ActiveSheet.Cells(NumLigneFin, 5)
End If
Loop
'Les deux lignes (dont je ne me souvient pu mais retrouvable dans le code du premier commentaire) servant à insérer
' une ligne (vierge) viennent se cases ici.
ActiveSheet.Cells(NumLigneFin + 1, 5).Formula = ValeLigneFin + 1
ActiveSheet.Cells(NumLigneFin + 1, 4).Formula = "."
ActiveSheet.Cells(NumLigneFin + 1, 3).Formula = ActiveSheet.Cells(NumLigneFin, 3)
End Sub