Création de ligne et sous-ligne via bouton

Bonjour,

Je remercie par avance les personnes qui accorderons du temps à ma demande.
Je souhaiterais créer des "étages" à mon tableau que vous trouverez en pièce jointe. Lorsque je parle d'étage, c'est à dire un ensemble qui inclut le nom de l'étage, une ligne vide (ou deux) avec les formules, un bouton d'ajout de ligne (+) et ses sous-totaux.
Pour exemple ci-dessous l'étage "Fondations", comporte une ligne "radier" avec plusieurs formules, et ses sous-totaux.

Lorsqu'un étage est créé, il est ensuite possible en cliquant sur le bouton "+" d'ajouter d'autre ligne vide. Les sous-totaux prendront en compte l'ensemble des lignes de l'étage.

Je vous joins mon fichier ci-dessous.

Merci encore pour le temps accordée à ma demande.

Bonne journée :)

Salut Show Take,

voilà où j'en suis pour l'instant. À toi de voir si je continue ainsi

Il n'y a qu'un bouton de commande ActiveX pour l'ensemble.
- il se déplace avec les clics de souris
- vert si clic gauche (pour ajout) ou rouge si clic droit (pour suppression)

En face d'une section, création ou suppression de section (étage comme tu dis)
En face d'une ligne de cette section, création ou suppression.

Je reviens plus tard : visite familiale!

A+

Salut Curulis,

Avant tout, merci pour ton aide !
Je viens de regarder, et je trouve que c'est encore mieux que ce que j'avais pensé.
La seule chose qu'il reste est le fait de garder les formule sous-totaux et aussi pour la ligne vide (blanche), les mêmes formules partout.

Je pense que tu n'as pas eu le temps de le finir, mais le travail que tu as fais est déjà juste parfait !

Dans l'attente de ton retour,

Bonne fin de journée

Bonjour

Bonjour à tous

Une variante.

Bye !

Bonjour ShowTaKe, Curulis, gmb, le forum ,

Je vois que le sujet à inspiré beaucoup de monde, alors pour le fun, je poste aussi .

En cliquant dans la colonne 'C', un petit Plus (+) apparaît...

Si vous voulez ajouter une simple ligne, le petit Plus (+) sera noir ou si vous voulez ajouter un "étage" le petit Plus (+) sera rouge.

Cliquez dessus, le nombre de lignes voulues sera ajouté en dessous de la ligne ou du bloc sélectionné.

J'ai mis quelques garde-fou pour par exemple ne pas ajouter de ligne si il y a le mot "SOUS TOTAL" inscrit dans la ligne, ou encore éviter de supprimer les formes (shape) si vous supprimez une ligne.

À vous de tester !

Le classeur :

Cordialement.

AL 22

Bonjour gmb et AL 22,

Je suis heureux de voir que mon soucis inspire beaucoup de monde.
gmb, merci pour ta proposition, je l'ai regardée, ça peut être intéressant notamment si l'on souhaite cacher le système de création de ligne. Cependant pour un côté un peu plus ludique, je partirai plutôt sur les idées de AL22 et Curulis.

AL 22, j'aime beaucoup ton idée qui se rapproche également du tableau de Curulis, cependant j'essaie en vain de faire une modification sur ton tableau notamment sur la création de ligne (+ Noir), mais je n'y arrive pas. Du moins je ne trouve pas la solution en modifiant ta macro...
"J'essaie de lire et comprendre un peu votre code avant de l'utiliser..."

En effet il faudrait plutôt que la ligne se crée au dessus et non en dessous, sinon les valeurs inscrites dans la ligne créé ne sont pas pris en compte dans la ligne des sous totaux. Je pense que tu t'y connaitra mieux que moi dans ta macro, si tu arrive à régler ce soucis

Merci encore pour le temps accordée !

Salut Show Take,
Salut les as,

version complétée avec copie des formules, etc, etc...
Cela demande évidemment d'être exposé au feu de la réalité!

Private Sub cmdOK_Click()
'
Dim iRow%, iTRow%, iCol%, iSize%, sCol$
'
iRow = ActiveCell.Row
iCol = Range("A" & iRow).End(xlToRight).Column
If (iCol = 3 And Cells(iRow, iCol) <> "") Or (iCol > 3 And Cells(iRow, iCol).Interior.ColorIndex = xlColorIndexNone) Then
    If cmdOK.BackColor = RGB(190, 0, 0) Then
        If MsgBox("Veuillez confirmer la suppression!", vbCritical + vbYesNo + vbDefaultButton2, "Alerte info") = vbYes Then _
            iTRow = Range("D" & iRow + 1).Resize(100, 1).Find(what:="SOUS TOTAL", lookat:=xlWhole, LookIn:=xlValues, searchdirection:=xlNext).Row: _
            Range("A" & iRow & ":A" & iTRow).EntireRow.Delete Shift:=xlUp
    Else
        iSize = IIf(iCol = 3, 3, 1)
        Rows(iRow).Resize(iSize).EntireRow.Insert Shift:=xlUp, CopyOrigin:=xlFormatFromRightOrBelow
        If iSize = 1 Then                                                   'création d'une ligne de la section
            Range("A" & iRow + 1 & ":BZ" & iRow + 1).Copy
            Range("A" & iRow & ":BZ" & iRow).PasteSpecial xlPasteFormats
            Range("A" & iRow & ":BZ" & iRow).PasteSpecial xlPasteFormulas
        Else
            Range("A" & iRow + 3 & ":BZ" & iRow + 4).Copy                   'création d'une section
            Range("A" & iRow & ":BZ" & iRow + 1).PasteSpecial xlPasteFormats
            iTRow = Range("D" & iRow + 3).Resize(100, 1).Find(what:="SOUS TOTAL", lookat:=xlWhole, LookIn:=xlValues, searchdirection:=xlNext).Row
            Range("A" & iTRow & ":BZ" & iTRow).Copy
            Range("A" & iRow + 2 & ":BZ" & iRow + 2).PasteSpecial xlPasteFormats
            Range("A" & iRow + 2 & ":BZ" & iRow + 2).PasteSpecial xlPasteFormulas
            Range("A" & iTRow - 1 & ":BZ" & iTRow - 1).Copy
            Range("A" & iRow + 1 & ":BZ" & iRow + 1).PasteSpecial xlPasteFormulas
            If iCol = 3 Then
                Range("C" & iRow).Value = "Section"
                Range("D" & iRow + 2).Value = "SOUS TOTAL"
                Range("F" & iRow + 2).FormulaLocal = "=C" & iRow
                For x = 7 To Cells(7, Columns.Count).End(xlToLeft).Column
                    If Cells(iRow + 2, x).HasFormula Then _
                        sCol = Split(Columns(x).Address(ColumnAbsolute:=False), ":")(1): _
                        Range(sCol & iRow + 2).FormulaLocal = "=SOUS.TOTAL(9;" & sCol & iRow & ":" & sCol & iRow + 1 & ")"
                Next
            End If
        End If
        On Error Resume Next
        Range("A" & iRow + IIf(iSize = 1, 0, 1) & ":G" & iRow + IIf(iSize = 1, 0, 1)).ClearContents
        Range("A" & iRow + IIf(iSize = 1, 0, 1) & ":BZ" & iRow + IIf(iSize = 1, 0, 1)).SpecialCells(xlCellTypeConstants, 3).ClearContents
        On Error GoTo 0
    End If
    Application.CutCopyMode = False
    Range("A" & iRow).Select
End If
'
End Sub

A+

Salut le forum,
Salut les as,

Un p'tit truc auquel je n'avais pas pensé : pour conserver la possibilité de copier-coller avec le bouton droit, le switch entre mode Vert-Rouge ne peut se faire avec le clic droit QUE sur la colonne [A:A]

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
'
If Not Intersect(Target, Columns(1)) Is Nothing Then _
    cmdOK.BackColor = IIf(cmdOK.BackColor = RGB(190, 0, 0), RGB(0, 170, 0), RGB(190, 0, 0)): _
    cmdOK.Height = Target.Height: _
    cmdOK.Top = Target.Top: _
    Cancel = True
'
End Sub

A+

Bonjour à tous,

Voici ma correction pour conserver les sous-totaux de chaque colonne concernées lors de l'ajout de lignes.

J'espère que cela répondra à votre demande .

Bonne journée.

AL 22

Salut tout le monde,

dernière correction/adaptation.
Pas le temps (encore) de faire mieux pour l'instant.

A+

Bonjour AL22, et Curulis,

Je viens de regarder vos tableaux qui correspondent parfaitement à mes besoins.
Je vous remercie pour le travail et le temps que vous avez accordée à ma demande et vous souhaite une très bonne journée.
Au plaisir de se retrouver peut-être sur le forum pour une autre question sur ce tableau. Je vais regarder d'abord de mon côté si j'arrive à remodifier une de mes anciennes macro

Bonne soirée et merci encore