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

Résolu
winflow Messages postés 179 Statut Membre -  
winflow Messages postés 179 Statut Membre -
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

4 réponses

  1.
    pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
     
    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
    1. winflow Messages postés 179 Statut Membre 22
       
      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
  2. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
     
    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
    1. winflow Messages postés 179 Statut Membre 22
       
      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
    2. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
       
      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
    3. winflow Messages postés 179 Statut Membre 22
       
      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
    4. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
       
      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
    5. winflow Messages postés 179 Statut Membre 22
       
      non quand je dis le dernier en date je voulais dire le dernier créer
      0
  3. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
     
    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
    1. winflow Messages postés 179 Statut Membre 22
       
      Ç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
    2. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
       
      Les valeurs sont dans le classeur que tu as fourni...
      Il suffit de les reproduire avec l'enregistreur de macro.....
      0
    3. winflow Messages postés 179 Statut Membre 22
       
      c'est à dire ?
      0
    4. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
       
      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
    5. winflow Messages postés 179 Statut Membre 22
       
      C'est ok =)
      0
  4. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
     
    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
    1. winflow Messages postés 179 Statut Membre 22
       
      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
    2. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
       
      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 cellule si l'autre se fait remplir
TheCrazyMod -
TheCrazyMod -

5 réponses
Excel : Remplir une cellule en fonction d'une autre
Alexisarnx -
votre psychiatre -

3 réponses
Reactiver la fusion des cellules, tableau exc
chector10 -
chector10 -

38 réponses
Remplir une cellule (texte) en fonction d'une autre (texte).
SOMUM -
SOMUM -

4 réponses
Message "cette fonction n'est pas disponible actuellement"
daladala -
Lucaslebg -

15 réponses