Ajout/Suppression de tableaux selon une entrée

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion apt
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
A

apt

XLDnaute Impliqué
Bonsoir,

J'aimerais lors de la saisie d'un "e" dans la colonne "E", un tableau vient s'ajouter à une ligne calculée en bas, avec les données correspondantes à la ligne cible,

Si ce "e" est éffacé de la colonne "E", le tableau correspondant s'éfface aussi,

Plus d'explications en fichier joint.

Merci.
 

Pièces jointes

Trier par date Trier par votes
Re : Ajout/Suppression de tableaux selon une entrée

Bonjour Apt, Skoobi

Quand tu fais du multi post sur plusieurs forums il est préférable de prévenir les uns et les autres...

www.veriti.net :: Voir le sujet - Ajout/Suppression de tableaux selon une entrée

@+
 
Vote positif 0 Vote négatif
Re : Ajout/Suppression de tableaux selon une entrée

Re bonjour apt,

on insere une ligne supplementaire pour le prochain echeancier qui sera payé
Cliquez pour agrandir...

voici le code modifié (il faut supprimer tout le code d'origine):
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim li As Long
    Application.EnableEvents = False
    li = Range("A1").CurrentRegion.Rows.Count + 1
    lig = li + 2
'    MsgBox "li : " & li & ", lig = " & lig    '=11
    If Target.Count = 1 Then
'Si "e" renseigné
        If Target.Column = 5 And Target.Row <= Range("A1").End(xlDown).Row And Target.Value = "e" Then
            With Range("A" & lig & ":B" & lig + 1).Borders
                .LineStyle = xlContinuous
                .Weight = xlThin
            End With
            Range("A" & lig).Value = "Crédit"
            Range("B" & lig).Value = "Intitulé"
            Range("A" & lig + 1).Value = Range("A" & Target.Row).Value    '10000
            Range("B" & lig + 1).Value = Range("B" & Target.Row).Value    'T
    
            With Range("A" & lig + 2 & ":C" & lig + 3).Borders
                .LineStyle = xlContinuous
                .Weight = xlThin
            End With
    
            Range("A" & lig + 2).Value = "Verser"    ' 20000
            Range("B" & lig + 2).Value = "Date"    ' 28-12-2007
            Range("C" & lig + 2).Value = "Reste"    ' 20000
            Range("B" & lig + 3).Value = Date
            Range("B" & lig + 3).Columns.EntireColumn.AutoFit
            Range("C" & lig + 3).Value = Range("A" & lig + 1).Value - Range("A" & lig + 3).Value
    
            Range("A" & lig & ":B" & lig).Font.Italic = True
    
            With Range("A" & lig + 1)
                .NumberFormat = "_(* #,##0.00_);_(* (#,##0.00);_(* ""-""??_);_(@_)"
                With .Font
                    .Name = "Arial"
                    .FontStyle = "Gras"
                    .Size = 8
                    .ColorIndex = 11
                End With
            End With
    
            With Range("B" & lig + 1)
                With .Font
                    '.Bold = True
                    '.Italic = True
                    .Name = "Arial"
                    .FontStyle = "Gras italique"
                    .Size = 8
                    .ColorIndex = 2
                End With
                With .Interior
                    .ColorIndex = 41
                    .Pattern = xlSolid
                    .PatternColorIndex = xlAutomatic
                End With
            End With
    
            Range("A" & lig + 2 & ":C" & lig + 2).Font.Italic = True
    
            With Range("A" & lig + 4)
                .NumberFormat = "_(* #,##0.00_);_(* (#,##0.00);_(* ""-""??_);_(@_)"
                With .Font
                    .Name = "Arial"
                    .FontStyle = "Gras"
                    .Size = 8
                    .ColorIndex = 10    '11
                End With
            End With
    
            With Range("C" & lig + 3)
                .NumberFormat = "_(* #,##0.00_);_(* (#,##0.00);_(* ""-""??_);_(@_)"
                With .Font
                    .Name = "Arial"
                    .FontStyle = "Gras"
                    .Size = 8
                    '.Strikethrough = False
                    '.Superscript = False
                    '.Subscript = False
                    '.OutlineFont = False
                    '.Shadow = False
                    '.Underline = xlUnderlineStyleNone
                    .ColorIndex = 3
                End With
            End With
'quand le crédit est renseigné
        ElseIf Target.Font.ColorIndex = 10 And IsNumeric(Target.Value) And Target.Offset(0, 2).Value > 0 Then
            Range(Target, Target.Offset(0, 2)).Copy
            Target.Offset(1, 0).Insert Shift:=xlDown
            Application.CutCopyMode = False
            Target.Offset(1, 0).Value = 0
            Target.Offset(1, 1).ClearContents
        End If
    End If
    Application.EnableEvents = True

End Sub

1-Est-ce absolument nécessaire que les tableaux soient sur 2 colonnes?
2-Plutôt que d'effacer le tableau lorsque le crédit a été remboursé, je te propose de supprimer les cellules correspondantes et de ce fait décaler les tableaux du dessous vers le haut.
Le code sera moins compliqué a faire.
A te relire.
 
Vote positif 0 Vote négatif
Re : Ajout/Suppression de tableaux selon une entrée

Bonjour skoobi,

Je vois que tu n'as pas beaucoup utilisé :

Code: 
CurrentRegion

pour connaître le nombre de lignes d'un tableau, et tu as utilsé avec, le
Code: 
Range("A1").End(xlDown).Row

Pour le code d'insertion d'une nouvelle ligne, si le reste du crédit n'a pas atteint le zéro :

Code: 
'quand le crédit est renseigné
        ElseIf Target.Font.ColorIndex = 10 And IsNumeric(Target.Value) And Target.Offset(0, 2).Value > 0 Then
            Range(Target, Target.Offset(0, 2)).Copy
            Target.Offset(1, 0).Insert Shift:=xlDown
            Application.CutCopyMode = False
            Target.Offset(1, 0).Value = 0
            Target.Offset(1, 1).ClearContents

        End If

Il n'a pas fonctionné.

skoobi à dit:
1-Est-ce absolument nécessaire que les tableaux soient sur 2 colonnes?
Cliquez pour agrandir...

Ce n'est pas obligatoire, mais seulement une façon de laisser sous les yeux tout les tableaux.

2-Plutôt que d'effacer le tableau lorsque le crédit a été remboursé, je te propose de supprimer les cellules correspondantes et de ce fait décaler les tableaux du dessous vers le haut.
Le code sera moins compliqué a faire.
A te relire.
Cliquez pour agrandir...

C'est une trés bonne idée.

Merci.
 
Dernière édition:
Vote positif 0 Vote négatif
Re : Ajout/Suppression de tableaux selon une entrée

Re bonjour,

apt à dit:
Pour le code d'insertion d'une nouvelle ligne, si le reste du crédit n'a pas atteint le zéro :

Code: 
'quand le crédit est renseigné
        ElseIf Target.Font.ColorIndex = 10 And IsNumeric(Target.Value) And Target.Offset(0, 2).Value > 0 Then
            Range(Target, Target.Offset(0, 2)).Copy
            Target.Offset(1, 0).Insert Shift:=xlDown
            Application.CutCopyMode = False
            Target.Offset(1, 0).Value = 0
            Target.Offset(1, 1).ClearContents

        End If

Il n'a pas fonctionné.
Cliquez pour agrandir...

Attention: pour que ça marche, il faut que la couleur du montant saisie soit vert: "ElseIf Target.Font.ColorIndex = 10 ", qu'il s'agit bien d'un nombre:"IsNumeric(Target.Value)" et que le reste ne face pas 0 (logique):"Target.Offset(0, 2).Value > 0".
 
Vote positif 0 Vote négatif
Re : Ajout/Suppression de tableaux selon une entrée

Bonsoir skoobi,

skoobi à dit:
Re bonjour,



Attention: pour que ça marche, il faut que la couleur du montant saisie soit vert: "ElseIf Target.Font.ColorIndex = 10 ", qu'il s'agit bien d'un nombre:"IsNumeric(Target.Value)" et que le reste ne face pas 0 (logique):"Target.Offset(0, 2).Value > 0".
Cliquez pour agrandir...

C'est que j'ai testé mais il n'y a pas d'insertion d'une nouvelle ligne !!!
 
Vote positif 0 Vote négatif
Re : Ajout/Suppression de tableaux selon une entrée

Re,
pour que les macros évenementielles fonctionnent, il faut que "Application.EnableEvents" soit à "True".
Pour ce faire, dans VBE, affiche la fenêtre d'execution via le menu affichage ou Ctrl+G puis tu écris ceci:
Application.EnableEvents = True
Une fois écrit, appuie sur entrée et le tour est joué.
Celà peut ce produire si dans une macro il y eu un plantage et que cette instruction a été "executé" avant le plantage: " Application.EnableEvents = False
".
Voilà.
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

E
  • Question Question
Microsoft 365 Règle de surbrillance d'une cellule qui dépasse une valeur selon l'intitulé d'une colonne.
Réponses
2
Affichages
278
Emeline20
E
Magnio
  • Résolu(e)
Microsoft 365 Pointer vers une Ligne/Case selon une sélection
Réponses
10
Affichages
367
Magnio
Magnio
piga25
  • Résolu(e)
XL 2016 En VBA, Automatiser la réponse en fonction de l'état d'une cellule.
Réponses
7
Affichages
872
piga25
piga25
S
  • Résolu(e)
Microsoft 365 Choisircols et ajout de colonne
Réponses
14
Affichages
570
AtTheOne
AtTheOne
S
  • Résolu(e)
Microsoft 365 Reporter le contenu d'une plage dans une cellule selon un ordre précis
Réponses
4
Affichages
403
sebastien176
S
S
  • Question Question
Microsoft 365 Tableaux Structurées : récupérer des données uniques pour consolider un bilan
Réponses
4
Affichages
419
vgendron
vgendron
M
  • Résolu(e)
XL 2021 Verrouillage de cellules après exécution d'une macro
2
Réponses
23
Affichages
1 K
MATLEA
M
S
  • Résolu(e)
Microsoft 365 [RESOLU] Excel : Calcul de prix en fonction d'un type
Réponses
4
Affichages
608
JHA
J
jeff1494
  • Question Question
XL 2021 Détecter un changement dans un des contrôles de formulaire et mettre à jour un TS correspondant.
2
Réponses
15
Affichages
702
jeff1494
jeff1494
D
  • Question Question
Power Query query - calculer le taux de tva
Réponses
5
Affichages
558
JFL_XLD
J
J
  • Question Question
Microsoft 365 Naviguer dans un tableau pour copier des données dans un modèle et copier l'un derrière l'autre
Réponses
11
Affichages
543
AtTheOne
AtTheOne
R
  • Question Question
XL 2010 Copie de plusieurs plages de cellules spécifiques dans le presse-papier
2
Réponses
20
Affichages
934
Dranreb
Dranreb
C
  • Résolu(e)
Copier/Masquer des lignes de couleur pour alimenter un tableau
Réponses
9
Affichages
931
vgendron
vgendron
F
  • Question Question
Microsoft 365 alerte
Réponses
5
Affichages
488
Fab1403
F
M
  • Question Question
XL 2021 Avoir des tableaux liés à une base de données
2
Réponses
24
Affichages
1 K
Nain porte quoi
Nain porte quoi
oguruma
POWERQUERY :: Combinaison de tableaux structurés Excel pouvant être issus de répertoires différents avec des noms de tableaux structurés différents
Réponses
0
Affichages
296
oguruma
oguruma
H
  • Question Question
XL 2013 Saisie sécurisée numéros de téléphone et ajout fonction clic droit de la souris
2
Réponses
21
Affichages
1 K
Helios77
H
M
  • Question Question
Microsoft 365 Impossible de copier une formule
Réponses
3
Affichages
402
moanin
M
oguruma
EXCEL :: Effectuer des regroupements avec agrégations de données :: GROUPER.PAR
Réponses
1
Affichages
794
oguruma
oguruma
L
  • Question Question
XL 2019 aligner textbox userform et valeur de cellule
Réponses
1
Affichages
518
fanfan38
fanfan38
Retour