Recupération de lignes d'un bouton = problème

Question

Bonjour, 

A l'heure actuelle dans  chaque case de la colonne L j'ai un bouton ( forme auquel il à été attribuée une macro). Quand je cliques sur ce bouton, il se passe différentes chose... 

Cf onglet préventif: https://www.cjoint.com/?0GmkolkgfXH 


Ce fonctionnement m'oblige si j'ajoutes une ligne en début de classeur ( ligne 7 par exemple), à réattribuer les macro de tout les boutons se trouvant après...

Mon tableau de préventif va a termes atteindre plusieurs centaines d'actions...

Je pense que le fonctionnement par cellule peut être plus simple. Dans ma colonne L j'ai une cellule qui aurait le même but que mon bouton à l'heure actuelle : quand je cliques sur la cellule il se passe différentes chose...

Ce fonctionnement par une cellule pourrait - il m'éviter la réatribution des macros à chaque insertion de lignes ?

Avez-vous des idées du code à mettre en jeu ?

Merci,
DGVDR
Configuration: Windows Vista / Internet Explorer 7.0

melanie1324 · Answer

Coucou,

Il existe une solution à voir si elle peut te convenir :
quand tu es dans visual basic, cliques sur la feuille dans laquelle tu veux que lorsque tu cliques sur la colonne L, il se passe quelque chose.

tu mets ensuite ce code :
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If target.colum = 12 then
'tu mets ton code
end if

End Sub


En fait, à chaque fois que tu cliqueras n'importe ou dans la colonne L, cela déclenchera la macro.

DGVDR · Answer

Bonjour Melanie,

Merci de prendre le temps de me répondre.

Cependant je ne pense pas que ton code soit tout à fait adapté.

Car l'action ne se limite pas à chaque clique dans la colonne 12.

Chaque case de la colonne 12 amène une interaction particulière sur sa ligne.

Par exemple si je suis en L4, il va se passer certaines choses pour E4 , je vais avoir besoin de copier B & D 4 pour les coller sur une autre feuille...

A voir si tu as une idée,
Merci,
DGVDR

f894009 · Answer

Bonjour,

Si vous prenez les cellules de la colonne L a la place de boutons, sur evenement double_clic, vous n'avez besoin que d'une seule macro (sauf erreur de ma part, vu le code de vos macros boutons) ou vous calculerez les adresses et autres chose en fonction de la ligne de la cellule double_cliquee. Double_clic pour eviter les clics a l'insu de votre ou de leur plein gre si cela est dommageable.

Qu'en pensez-vous ??

DGVDR · Answer

Bonjour f894009,

C'est exactement ça, cependant je ne connais pas le code correspondant.

Plus que cette protection par double clic, je pensais mettre une MsgBox avec une validation d'action( comme c'est en place actuellement).

Si vous pouvez m'aider pour ce qui est du code.

Merci,
DGVDR

f894009 · Answer

Re,

Oui,

je regarde la chose.

A+

lermite222 · Answer

Bonjour ,
J'ai pas trouvé la feuille avec les boutons en question ?!
Par contre, ton code est assez.. heuu.
Exemple d'optimisation pour deux de tes procédures,
Sub graph2() 'DGVDR'
Dim F As Integer
Dim X As Integer
Dim TB(15) As Integer
Dim Compare
    Compare = Array("AMOS", "PALL", "Laveuse", "Bucher", "Centrifugeuse", "Kieselguhr", "Padovan", "Insectocuteur TTJ", "Macérateur", "Pompe bassin rétention", "Pompe Schneider", "Pompe liverani 1", "Pompe liverani elec", "Flash pasteurisateur", "Pompe Lucne", "Pompe liverani 2")
    With Sheets("Enregistrements interventions")
        For F = 3 To 500
      'Test si = C ou c
            If .Range("D" & F) = "Curatif" Then
                For X = 0 To 15
                    If .Range("C" & F) = Compare(X) Then
                        TB(X) = TB(X) + 1: Exit For
                    End If
                Next X
            End If
        Next F
    End With
    
    With Sheets("Global")
        For X = 0 To 14: .Cells(27, X + 2) = TB(X): Next
        .Cells(27, "T") = TB(15)
    End With
End Sub

Sub graph3() 'DGVDR'
Dim AC As Integer
Dim AD As Integer ' Clark'
Dim AE As Integer 'Tire pal'
Dim AF As Integer ' Karcher'
Dim AG As Integer ' Chario Mitsu'
Dim AH As Integer 'Compresseur'


    With Sheets("Enregistrements interventions")
        For AC = 3 To 500
            'Test si = C ou c
            If .Range("D" & AC) = "C" Then
                Select Case .Range("C" & AC)
                Case "Chariot Clark": AD = AD + 1
                Case "Tire-palette elec": AE = AE + 1
                Case "Karcher": AF = AF + 1
                Case "Chariot mitsubishi": AG = AG + 1
                Case "Compresseur": AH = AH + 1
                End Select
            End If
        Next AC
    End With
  
    With Sheets("Global")
        .Range("B47") = AD
        .Range("C47") = AE
        .Range("D47") = AF
        .Range("E47") = AG
        .Range("F47") = AH
  End With
  
End Sub
 Tu en tire ce que tu veux...
A+

f894009 · Answer

Bonjour lermite,

onglet Préventif (je n'ai pas trouve du premier coup.)

DGVDR


a mettre dans VBA de la feuille Préventif

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim machine As String
    Dim Détails As String
    Dim Cel_Lig_Clic As Integer

    'derniere cellules non vide colonne B
    derlig = Range("B" & Rows.Count).End(xlUp).Row
    'test clic colonne L: L8 a Lx
    If Not Application.Intersect(Target, Range("L8:L" & derlig)) Is Nothing Then
        'mesage
        If MsgBox("Confirmer ", vbYesNo + vbInformation, "Confirmation") = vbYes Then
            'ligne cellule
            Cel_Lig_Clic = Target.Row
            'ecriture infos
            Worksheets("Préventif").Range("I" & Cel_Lig_Clic) = "" ' suppression du commentaire'
            Détails = Worksheets("Préventif").Range("D" & Cel_Lig_Clic) ' Prise du détail de l'inter'
            machine = Worksheets("Préventif").Range("B" & Cel_Lig_Clic)

            With Worksheets("Enregistrements interventions")
                numligne = .Range("A65536").End(xlUp).Row + 1             ' Détermination de la dernière ligne du tableau enregistrement inter'
                .Range("C" & numligne).Value = machine                         ' Incrémentation de la machine sur laquelle l'action à été faites
                .Range("D" & numligne) = "Préventif"                              ' Incrémentation du type (Cur ou Pré'
                .Range("F" & numligne) = Sheets("Préventif").Range("B1") ' incrémentation de la date sur la feuille enregistrement inter'
                .Range("H" & numligne) = Détails
            End With
            Sheets("Préventif").Range("E" & Cel_Lig_Clic) = Sheets("Préventif").Range("B1") ' incrémentation de la date sur la feuille préventif'
            UserForm1.Show
        End If
    End If
End Sub


A+

DGVDR · Answer

Bonjour lermite222,

Je suis tout à fait conscient que mon code n'est pas optimiseé en temps d'exécution.
Cependant n'étant pas un expert du codage, j'essayes d'utiliser des codes simples que je maîtrises, et de les dupliquer.

Je suis preneur de tout exemple d'amélioration ( comme tu l'as fait), afin que mon code soit plus performant à l'avenir.

Je vais examiner ton code, voir ce que je peux en faire à partir de ce que j'en comprends.

Merci f894009,

Je vais tester ça dans l'après midi.

Merci à vous deux.
DGVDR

DGVDR · Answer

f894009,

Ton code fonctionne à merveille.
--------------------------------------------------
DGVDR

DGVDR · Answer

Bonjour lermite222, 


Quelques questions :

Je ne comprends pas :

Compare = Array("AMOS", "PALL", "Laveuse", "Bucher", "Centrifugeuse", "Kieselguhr", "Padovan", "Insectocuteur TTJ", "Macérateur", "Pompe bassin rétention", "Pompe Schneider", "Pompe liverani 1", "Pompe liverani elec", "Flash pasteurisateur", "Pompe Lucne", "Pompe liverani 2")

Qu'est ce que Array ?

 For X = 0 To 14: .Cells(27, X + 2) = TB(X): Next
        .Cells(27, "T") = TB(15)

Je ne comprends pas ce code 

Merci pour le temps passé,

DGVDR

lermite222 · Answer

Array est l'équivalent d'un tableau mais est plus facile à implémenter plutôt que
Compare(0) = "AMOS"
Compare(1) =  "PALL"
Compare(2) =  "Laveuse"
Etc.

Dans la première boucle ont test si la cellule est égale à Compare(X) si oui, ont incrémente TB(X) où X est le même indice que Compare(X)  
Ont sait donc, à la sortie que le nombre de..
Compare(0) = "AMOS" est contenu TB(0) fois dans la feuille
de même pour tout les autres.
Comme j'ai tout mis en ligne.. TB(0) ira en B27, TB(1) en C27 etc..
Y à plus qu'a faire une boucle pour assigner les valeurs aux bonnes cellules.
Sauf pour la dernière qui n'est pas dans la continuité linéaire.

Si pas encore claire.. hésite pas pour les questions.
A+ 
EDIT : une touche très utile F1
Tu double clic, par exemple sur ARRAY et tu tape F1, tu auras tous les renseignements utiles sur cette fonctions.
Si tu te cognes à un pot et que ça sonne creux, c'est pas forcément le pot qui est vide. ;-)(Confucius)
Note: Je ne répond pas aux MP pour les questions techniques. Et ma boule de cristal est cassée .

f894009 · Answer

Re,

pour poursuivre dans la cogitation:

'F894009 (ou j'en etais pour ce module)
Sub graph2() 'DGVDR'

  Dim F As Integer ' Variable comparatrice'
  Dim G As Integer ' Variable AMOS'
  Dim H As Integer ' Variable BUCHER'
  Dim i As Integer ' Variable PALL'
  Dim J As Integer ' Variable Kieselguh'
  Dim K As Integer ' Variable Padovan'
  Dim L As Integer ' Variable Insectocuteur TTJ'
  Dim m As Integer ' Variable Macérateur'
  Dim n As Integer ' Variale Flash pasteurisateur'
  Dim o As Integer ' Variable Pompe Schneider '
  Dim P As Integer ' Variable Pompe Lucne'
  Dim Q As Integer ' Variable Pompe bassin rétention'
  Dim R As Integer ' Variable liverani 1'
  Dim S As Integer ' Variable liverani 2 '
  Dim T As Integer ' Variable liverani elec'
  Dim U As Integer ' variable centri'
  Dim V As Integer ' Variable Laveuse'
  Dim plage As Range, Nb_occ As Integer, lig As Integer, L As Integer
  
    With Worksheets("Enregistrements interventions")
        'derniere cellules non vide colonne B
        derlig = .Range("D" & Rows.Count).End(xlUp).Row

        Set plage = .Range("D3:D" & derlig)
        Nb_occ = Application.CountIf(plage, "Curatif")
  
        If Nb_occ > 0 Then
            F = 2
            For L = 1 To Nb_occ
                F = .Columns("D").Find("Curatif", .Cells(F, "D"), , xlWhole).Row
                If .Range("C" & F) = "AMOS" Then  'Comparaison effectué sur la feuille 3'
                    G = G + 1 ' Incrémentation de l'indice la case F3 sur la feuille 1'
                ElseIf .Range("C" & F) = "Bucher" Then  'Comparaison effectué sur la feuille 3'
                    H = H + 1 ' Incrémentation de l'indice de la case C3 sur la feuille 1'
                ElseIf .Range("C" & F) = "PALL" Then  'Comparaison effectué sur la feuille 3'
                    i = i + 1 ' Incrémentation de l'indice la case I3 sur la feuille 1'
                ElseIf .Range("C" & F) = "Kieselguhr" Then  'Comparaison effectué sur la feuille 3'
                    J = J + 1
                ElseIf .Range("C" & F) = "Padovan" Then  'Comparaison effectué sur la feuille 3'
                    K = K + 1
                ElseIf .Range("C" & F) = "Insectocuteur TTJ" Then  'Comparaison effectué sur la feuille 3'
                    L = L + 1 '
                ElseIf .Range("C" & F) = "Macérateur" Then  'Comparaison effectué sur la feuille 3'
                    m = m + 1
                ElseIf .Range("C" & F) = "Flash pasteurisateur" Then  'Comparaison effectué sur la feuille 3'
                    n = n + 1
                ElseIf .Range("C" & F) = "Pompe Schneider" Then  'Comparaison effectué sur la feuille 3'
                    o = o + 1
                ElseIf .Range("C" & F) = "Pompe Lucne" Then  'Comparaison effectué sur la feuille 3'
                    P = P + 1
                ElseIf .Range("C" & F) = "Pompe bassin rétention" Then  'Comparaison effectué sur la feuille 3'
                    Q = Q + 1
                ElseIf .Range("C" & F) = "Pompe liverani 1" Then  'Comparaison effectué sur la feuille 3'
                    R = R + 1
                ElseIf .Range("C" & F) = "Pompe liverani 2" Then  'Comparaison effectué sur la feuille 3'
                    S = S + 1
                ElseIf .Range("C" & F) = "Pompe liverani elec" Then  'Comparaison effectué sur la feuille 3'
                    T = T + 1
                ElseIf .Range("C" & F) = "Centrifugeuse" Then  'Comparaison effectué sur la feuille 3'
                    U = U + 1
                ElseIf .Range("C" & F) = "Laveuse" Then  'Comparaison effectué sur la feuille 3'
                    V = V + 1
                End If
            Next L
        End If
  
  End With

  With Worksheets("Global")
        .Range("B27") = G
        .Range("E27") = H
        .Range("C27") = i
        .Range("G27") = J
        .Range("H27") = K
        .Range("I27") = L
        .Range("J27") = m
        .Range("O27") = n
        .Range("L27") = o
        .Range("P27") = P
        .Range("K27") = Q
        .Range("M27") = R
        .Range("T27") = S
        .Range("N27") = T
        .Range("F27") = U
        .Range("D27") = V
  End With

End Sub

'mixe des deux: lermite (excellant)& F894009
Sub graph2() 'DGVDR'
Dim F As Integer
Dim X As Integer
Dim TB(15) As Integer
Dim Compare
    Compare = Array("AMOS", "PALL", "Laveuse", "Bucher", "Centrifugeuse", "Kieselguhr", "Padovan", "Insectocuteur TTJ", "Macérateur", "Pompe bassin rétention", "Pompe Schneider", "Pompe liverani 1", "Pompe liverani elec", "Flash pasteurisateur", "Pompe Lucne", "Pompe liverani 2")
    
    With Sheets("Enregistrements interventions")
        'derniere cellules non vide colonne B
        derlig = .Range("D" & Rows.Count).End(xlUp).Row

        Set plage = .Range("D3:D" & derlig)
        'N fois
        Nb_occ = Application.CountIf(plage, "Curatif")
        'trouve au moins un
        If Nb_occ > 0 Then
            F = 2
            'boucle n fois trouve
            For L = 1 To Nb_occ
                'cherche ligne
                F = .Columns("D").Find("Curatif", .Cells(F, "D"), , xlWhole).Row
                'boucle test valeur  fonction tableau
                For X = 0 To 15
                    If .Range("C" & F) = Compare(X) Then
                        TB(X) = TB(X) + 1: Exit For
                    End If
                Next X
            Next L
        End If
    End With
    
    With Sheets("Global")
        For X = 0 To 14: .Cells(27, X + 2) = TB(X): Next
        .Cells(27, "T") = TB(15)
    End With
End Sub

Amusez vous bien, le sub Graph() peut etre modifie pareil

j'ai modifie pas mal de code de votre fichier. A voir

lermite222 · Answer

Bonjour Fxx,
Il n'y a pas de données dans ses feuilles pour être certain mais je pense que le test "Curatif" n'est pas nécessaire, les éléments de Compare(X) ne se retrouveront probablement pas dans un autre contexte.
ce qui ferais drôlement simplifier avec.. exemple,
    For X = 0 To 15
        TB(X) = Application.CountIf(plage,Compare(X))
    Next
Je te passe l'idée.. :-)
A+
Amicalement, lermite.

DGVDR · Answer

Bonjour à vous deux,

Merci beaucoup pour ces améliorations.

Je regarde ça dans la semaine.

DGVDR

Recupération de lignes d'un bouton = problème

14 réponses

Discussions similaires

Newsletters