Sujet Précédent Sujet Suivant

Décalage de cellules en fonction d'un évènement

Résolu/Fermé
winflow Messages postés 156 Date d'inscription mercredi 7 avril 2010 Statut Membre Dernière intervention 17 mars 2015 - Modifié par winflow le 5/11/2013 à 11:24
winflow Messages postés 156 Date d'inscription mercredi 7 avril 2010 Statut Membre Dernière intervention 17 mars 2015 - 6 nov. 2013 à 15:05
Bonjour,

https://www.cjoint.com/?3Kflod4dlmk

Via cet exemple j'aimerais qu'on ajoute un formulaire si l'on clique sur le + (donc via à un évènement je pensais à 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
). Exemple si on cliques sur le premier plus on aurait ce fichier

https://www.cjoint.com/?3KflwVxtVOQ

PS: pas de solution sous Excel mais en VBA pour ceux qui ne l'aurait pas compris

Merci d'avance

Cordialement

Winflow
A voir également:

4 réponses

Réponse 1 / 4
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 743
5 nov. 2013 à 14:20
Bonjour,

Essaye ceci : 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Si plus d'une cellule sélectionnée, on quitte la procédure (évite de bugguer)
If Target.Count > 1 Then Exit Sub
'Si le contenu de la cellule sélectionnée n'est pas + alors on quitte la procédure
If Target.Value <> "+" Then Exit Sub
'Si le contenu de la colonne A, même ligne ne commence pas par 1, on quitte
'ceci pour éviter d'insérer n'importe quoi en cas de clic sur un autre +
If Left(Target.Offset(0, -30), 1) <> 1 Then Exit Sub
'si tout est ok, on copie
Range("A2:AF14").Copy
'et on insère
Range("A2").Insert Shift:=xlDown
'"nettoyage" des zones à saisir
Range("G3:O3,G6:O6,W3:AE3,G8:H8,G9:J9,G10:K10,W8:X8,W9:Z9,W10:Z10").Select
Selection.ClearContents
End Sub


Comme tu as plusieurs +, un pour chaque "paragraphe" (1-, 2-, 3 etc...), il sera possible de faire la même chose sur les + des autres paragraphes. Pour l'instant cela fonctionne avec celui du 1- comme souhaité...
1
winflow Messages postés 156 Date d'inscription mercredi 7 avril 2010 Statut Membre Dernière intervention 17 mars 2015 22
Modifié par winflow le 5/11/2013 à 15:15
Alors pourrais tu m'expliquer plus précisément ton code parce que j'ai du mal à suivre par ailleurs cela bloque après avoir cliquer 3 fois sur le +. Autre pb, lorsque je clique sur le premier + rien ne se passe c'est en cliquant sur le deuxième que cela fonctionne qui insère donc le premier formulaire ce qui n'est pas logique. Les if sont-ils imbriqués ? Car il n'ont pas de End If. Pourquoi ne pas rassembler toutes les conditions dans un seul if ?
0
Réponse 2 / 4
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 743
5 nov. 2013 à 15:18
Tu veux, par exemple pour AE1, lors d'un clic sur le +, les cellules de A2 à AF14 soient "dupliquées".

Pour cela, il faut tout d'abord repérer le clic sur un +, grâce à l'événement Selection_Change()

1- il ne doit pas y avoir plus d'une cellule sélectionnée sinon ça buggue. Donc : 
If Target.Count > 1 Then Exit Sub
2- Le contenu de la cellule sélectionnée doit être +. Donc : 
If Target.Value <> "+" Then Exit Sub
3- La copie et l'insertion des cellules A2:AF14 ne doit se faire que pour le 1 - Système de supervision. On se garde de côté la possibilité de faire ça pour les 2 - Interface supervision et 3 - Automate...
Donc :
Si le caractère de gauche de la cellule située sur la même ligne que celle du + qu'on vient de cliquer est un 1 : 
If Left(Target.Offset(0, -30), 1) <> 1 Then Exit Sub
4- Copie/Insertion => pas de souci???

J'ai créé et testé cette macro avec le fichier fourni. Si cela ne fonctionne pas bien c'est que ton fichier est différent......
1
winflow Messages postés 156 Date d'inscription mercredi 7 avril 2010 Statut Membre Dernière intervention 17 mars 2015 22
5 nov. 2013 à 15:41
Pourquoi les If ne possèdent pas de End If ? Est-il possible de concaténer les If ensemble avec des Or ? 
Range("A2").Insert Shift:=xlDown
que signifie le
 Shift:=xlDown
</code> ? Cela fonctionne merci maintenant j'ai du faire une fausse manip'. J'ai la même problématique avec le - seulement il doit rester au minimum un formulaire.
0
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 743
5 nov. 2013 à 15:49
Il y a plusieurs façons d'écrire un test If simple.
Soit en plusieurs lignes : 
If Machin = Truc Then
    Bidule = chose
End If
ou en une seule ligne : 
If Machin = Truc Then Bidule = chose
Ces deux tests sont rigoureusement identiques, c'est juste selon les habitudes du codeur...

que signifie le Shift:=xlDown
C'est la destination des cellules devant être remplacées par l'insertion. Lorsque tu insères des cellules sous excel, tu as le choix de placer les cellules à remplacer, au dessous, à gauche, à droite etc...
Là, on les veux en dessous, donc xlDown...

J'ai la même problématique avec le - seulement il doit rester au minimum un formulaire Et là, ça se complique.......
Lorsque tu as 5 (par exemple) formulaires, lequel effacer???
ça semble problématique.
Expose bien ton souhait alors...
0
winflow Messages postés 156 Date d'inscription mercredi 7 avril 2010 Statut Membre Dernière intervention 17 mars 2015 22
5 nov. 2013 à 15:56
OK d'accord comme quoi quand on connait bien le langage sa va tout seul. Je pense que l'on doit supprimer le dernier en date....
0
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 743
5 nov. 2013 à 16:00
Je pense que l'on doit supprimer le dernier en date....
Comme il n'y a de dates nulle part, j'en déduis qu'il faut supprimer la plage A2:AF14???
0
winflow Messages postés 156 Date d'inscription mercredi 7 avril 2010 Statut Membre Dernière intervention 17 mars 2015 22
5 nov. 2013 à 16:09
non quand je dis le dernier en date je voulais dire le dernier créer
0
Réponse 3 / 4
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 743
6 nov. 2013 à 12:15
Voici la proposition du jour.
Tu pourras, grâce à ce code supprimer toutes les supervisions, le code en créera une nouvelle le cas échéant.... 

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Lig As Integer

If Target.Count > 1 Then Exit Sub

Select Case Target.Value
    Case "+"
        If Left(Target.Offset(0, -30), 1) <> 1 Then Exit Sub
        'On cherche la ligne ou insérer
        'Soit la ligne au dessus de : 2- Interface supervision
        Lig = Columns(1).Cells.Find("2 - Interface supervision").Row - 1
        'S'il n'y a aucune supervision alors Lig = 2
        'Si Lig = 2, il faut saisir la supervision au lieu de la copier coller
        If Lig = 2 Then
            'on insère 13 lignes
            Rows("3:15").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            'fusionnage des cellules et mise en forme
            MiseEnForme Range("G3:L3")
            MiseEnForme Range("W3:AE3")
            MiseEnForme Range("G6:L6")
            MiseEnForme Range("G8:H8")
            MiseEnForme Range("W8:X8")
            MiseEnForme Range("G9:I9")
            MiseEnForme Range("W9:Z9")
            MiseEnForme Range("G10:K10")
            MiseEnForme Range("W10:Z10")
            Grise Range("A12:D12")
            Encadre Range("A13:AF14")
            SaisieEtiquettes
            Range("G3").Select
        Else
            'sinon, s'il existe déjà au moins une supervision, on la copie
            Range("A2:AF14").Copy
            'on insère à partir de la ligne trouvée plus haut
            Range("A" & Lig).Insert Shift:=xlDown
            Application.CutCopyMode = False
            Range("G3").Select
        End If
    Case "-"
        If Left(Target.Offset(0, -31), 1) <> 1 Then Exit Sub
        'On cherche la ligne ou on a insérer la dernière fois
        'Soit la ligne au dessus de : 2- Interface supervision
        Lig = Columns(1).Cells.Find("2 - Interface supervision").Row - 1
        'petit test pour ne pas tout supprimer
        If Lig > 10 Then
            'ON SUPPRIME!
            Rows(Lig - 12 & ":" & Lig).Delete
        End If
        Range("A1").Select
     Case Else
        Exit Sub
End Select
End Sub

Sub MiseEnForme(Rng As Range)
With Rng
    .Merge
    With .Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Color = -16711681
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With .Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Color = -16711681
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With .Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Color = -16711681
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With .Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Color = -16711681
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With .Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
End With
End Sub

Sub Grise(Rng As Range)
With Rng
    .Font.Bold = True
    With .Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.249946592608417
        .PatternTintAndShade = 0
    End With
    With .Font
        .ColorIndex = 1
        .TintAndShade = 0
    End With
End With
End Sub

Sub Encadre(Rng As Range)
With Rng
    .Borders(xlDiagonalDown).LineStyle = xlNone
    .Borders(xlDiagonalUp).LineStyle = xlNone
    With .Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With .Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With .Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With .Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    .Borders(xlInsideVertical).LineStyle = xlNone
    .Borders(xlInsideHorizontal).LineStyle = xlNone
End With
End Sub

Sub SaisieEtiquettes()
Range("A3").Value = "Localisation"
Range("A3").Font.Bold = True
Range("A3").Font.ColorIndex = 1
Range("A6").Value = "Adresse IP"
Range("A6").Font.Bold = True
Range("A6").Font.ColorIndex = 1
Range("A8").Value = "Mémoire physique"
Range("A8").Font.Bold = True
Range("A8").Font.ColorIndex = 1
Range("A9").Value = "Disque dur"
Range("A9").Font.Bold = True
Range("A9").Font.ColorIndex = 1
Range("A10").Value = "Résolution écran"
Range("A10").Font.Bold = False
Range("A10").Font.ColorIndex = 1
Range("A12").Value = "Observations"
Range("A12").Font.Bold = True
Range("A12").Font.ColorIndex = 1
Range("R3").Value = "Type supervision"
Range("R3").Font.Bold = True
Range("R3").Font.ColorIndex = 1
Range("R8").Value = "Date d'aquisition"
Range("R8").Font.Bold = True
Range("R8").Font.ColorIndex = 1
Range("R10").Value = "Imprimante"
Range("R10").Font.Bold = False
Range("R10").Font.ColorIndex = 1
Range("Q9").Value = "Système Exploitation"
Range("Q9").Font.Bold = True
Range("Q9").Font.ColorIndex = 1
End Sub
1
winflow Messages postés 156 Date d'inscription mercredi 7 avril 2010 Statut Membre Dernière intervention 17 mars 2015 22
6 nov. 2013 à 14:17
Ça fonctionne impeccable un grand merci comment tu as trouvé les valeurs pour tout ce qui est mise en forme (les valeurs qui sont dans les fonctions misenform, encadre et grise) ? Je vais me débrouille avec ton pgm même si l'application réel est bien plus complexe.
0
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 743
6 nov. 2013 à 14:20
Les valeurs sont dans le classeur que tu as fourni...
Il suffit de les reproduire avec l'enregistreur de macro.....
0
winflow Messages postés 156 Date d'inscription mercredi 7 avril 2010 Statut Membre Dernière intervention 17 mars 2015 22
6 nov. 2013 à 14:41
c'est à dire ?
0
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 743
Modifié par pijaku le 6/11/2013 à 14:45
1- j'ai regardé dans le classeur fourni qu'elles sont les couleurs, les bordures, les couleurs de polices etc...
2- j'ai lancé l'enregistrement d'une macro (onglet développeur - enregistrer une macro)
3- J'ai refait toutes les mises en forme pour que l'enregistreur enregistre le code de chaque manipulation
4- arrêté l'enregistreur
5- j'ai été récupérer le code dans le Module créé par l'enregistreur (dans mon cas Module1)
6- je l'ai un peu épuré et rangé sous forme de Sub...
0
winflow Messages postés 156 Date d'inscription mercredi 7 avril 2010 Statut Membre Dernière intervention 17 mars 2015 22
6 nov. 2013 à 15:05
C'est ok =)
0
Réponse 4 / 4
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 743
5 nov. 2013 à 17:11
Voili voilou.
reviens pour ce que tu ne comprends pas, le cas échéant...
J'ai utilisé un Select Case pour différencier le clic sur + du clic sur -... 

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Lig As Integer

If Target.Count > 1 Then Exit Sub

Select Case Target.Value
    Case "+"
        If Left(Target.Offset(0, -30), 1) <> 1 Then Exit Sub
        Range("A2:AF14").Copy
        'On cherche la ligne ou insérer
        'Soit la ligne au dessus de : 2- Interface supervision
        Lig = Columns(1).Cells.Find("2 - Interface supervision").Row - 1
        'et on insère à partir de cette ligne
        Range("A" & Lig).Insert Shift:=xlDown
        Application.CutCopyMode = False
    Case "-"
        If Left(Target.Offset(0, -31), 1) <> 1 Then Exit Sub
        'On cherche la ligne ou on a insérer la dernière fois
        'Soit la ligne au dessus de : 2- Interface supervision
        Lig = Columns(1).Cells.Find("2 - Interface supervision").Row - 1
        'petit test pour ne pas supprimer le premier exemplaire
        If Lig > 10 Then
            'ON SUPPRIME!
            Rows(Lig - 12 & ":" & Lig).Delete
        End If
     Case Else
        Exit Sub
End Select
End Sub
0
winflow Messages postés 156 Date d'inscription mercredi 7 avril 2010 Statut Membre Dernière intervention 17 mars 2015 22
Modifié par winflow le 6/11/2013 à 09:59
Re,

Petit pb, justement le premier exemplaire se supprime (ce qui est correct finalement on peut ne pas avoir de supervision ) mais lorsque l'on clique sur le + celui fait n'importe quoi
0
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 743
6 nov. 2013 à 11:31
justement le premier exemplaire se supprime (ce qui est correct finalement on peut ne pas avoir de supervision )
Il serait beaucoup plus simple de ne jamais supprimer le 1er exemplaire.....
Sinon, il faut à chaque fois refaire toute la mise en page par macro.........
Tu dis
0

Discussions similaires

Remplir une cellule (texte) en fonction d'une autre (texte).
SOMUM -
SOMUM -

4 réponses
Excel:récupérer le contenu d'une cellule en fonction d'une autre
tinky31 -
leplot -

1 réponse
Décalage son et image sur YouTube ?
Rubik4s -
Kybla -

7 réponses
Excel : colorer une cellule sous condition d'une autre ?
KAKEPATHEL -
Pascal -

15 réponses
Renseigner cellule en fonction de la valeur d'une autre cellule
Stargirlfr -
Stargirlfr -

2 réponses