Bonjour à tous,
Je suis entrain de tenter de faire un menu contextuel perso en adaptant un code trouvé sur le Forum (désolé je ne me rappelle plus de l'auteur...).
Voici donc le code pour ajouter les bouton de ce menu:
ce code permet donc d'ajouter autant de bouton qu'il y a de cellule remplies dans la colonne Q (à partir de Q12).
Jusque là tout va bien, ça marche.
Le problème arrive lorsque je clique sur l'un des bouton, qui appelle donc la sub "affectation" (avec un paramètre). Cette macro est exécutée 2 fois... là je ne comprend pas du tout....
Voici le code de la macro appelée au clique du bouton:
Si quelqu'un a une idée sur ce problème.
Merci pour votre coup de main!
Zè
Je suis entrain de tenter de faire un menu contextuel perso en adaptant un code trouvé sur le Forum (désolé je ne me rappelle plus de l'auteur...).
Voici donc le code pour ajouter les bouton de ce menu:
Code:
Private Sub BarAdd()
Dim cel As Range
Dim Lastresource As Integer
Dim colonne_resource As String
On Error Resume Next
BarDelete
Set BarDroit = CommandBars.Add(NomBarre, msoBarPopup, , True)
Lastresource = Sheets("Charges").Range("Q65000").End(xlUp).Row
For Each cel In Sheets("Charges").Range("Q13:Q" & Lastresource)
colonne_resource = Sheets("Charges").Cells(cel.Row, cel.Column + 1).Value
MsgBox (Chr(34) & "affectation(" & Chr(34) & colonne_resource & Chr(34) & ")" & Chr(34))
With BarDroit
With .Controls.Add(msoControlButton)
.Style = msoButtonCaption
.Caption = cel.Value
'.OnAction = Chr(34) & "affectation(" & Chr(34) & colonne_resource & Chr(34) & ")" & Chr(34)
.OnAction = "affectation(" & Chr(34) & colonne_resource & Chr(34) & ")"
End With
End With
Next cel
End Sub
ce code permet donc d'ajouter autant de bouton qu'il y a de cellule remplies dans la colonne Q (à partir de Q12).
Jusque là tout va bien, ça marche.
Le problème arrive lorsque je clique sur l'un des bouton, qui appelle donc la sub "affectation" (avec un paramètre). Cette macro est exécutée 2 fois... là je ne comprend pas du tout....
Voici le code de la macro appelée au clique du bouton:
Code:
Private Sub affectation(col As String)
Dim i As Integer
Dim charge As Variant
Dim j As Integer
Dim cel As Range
Dim rapport As String
Dim pays As String
Dim ligne As Integer
Dim ligne_charge As Integer
Dim col_charge As Integer
rapport = Selection.Value
pays = Cells(1, Selection.Column).Value
ligne = Selection.Row
With Selection.Interior
.Pattern = xlLightUp
End With
If rapport = "W" Then
ligne_charge = 2
ElseIf rapport = "M" Then ligne_charge = 3
ElseIf rapport = "F" Then ligne_charge = 4
ElseIf rapport = "G" Then ligne_charge = 5
End If
If pays = "GAB" Then
col_charge = 2
ElseIf pays = "RDC" Then col_charge = 3
ElseIf pays = "COG" Then col_charge = 4
ElseIf pays = "UGA" Then col_charge = 5
ElseIf pays = "TCD" Then col_charge = 6
ElseIf pays = "KEN" Then col_charge = 7
ElseIf pays = "TZA" Then col_charge = 8
ElseIf pays = "SLE" Then col_charge = 9
ElseIf pays = "BFA" Then col_charge = 10
ElseIf pays = "NER" Then col_charge = 11
ElseIf pays = "MWI" Then col_charge = 12
ElseIf pays = "ZMB" Then col_charge = 13
ElseIf pays = "MAD" Then col_charge = 14
ElseIf pays = "NGA" Then col_charge = 15
ElseIf pays = "GHA" Then col_charge = 16
End If
charge = Sheets("Charges").Cells(ligne_charge, col_charge)
'MsgBox (charge)
For Each cel In Sheets("Consultants").Range(col & ligne & ":" & col & 65535)
If Cells(cel.Row, 3).Value <> "Sa" Then
If Cells(cel.Row, 3).Value <> "Di" Then
If charge > 0 Then
'MsgBox (Sheets("Consultants").Cells(Range(col & cel.Row).Row, Range(col & cel.Row).Column + 1).Value)
If Sheets("Consultants").Cells(Range(col & cel.Row).Row, Range(col & cel.Row).Column + 1) < 1 Then
If Sheets("Consultants").Cells(Range(col & cel.Row).Row, Range(col & cel.Row).Column + 1) + charge > 1 Then
cel.Value = cel.Value & " " & rapport & "-" & pays
charge = charge - 1 + Sheets("Consultants").Cells(Range(col & cel.Row).Row, Range(col & cel.Row).Column + 1)
Sheets("Consultants").Cells(Range(col & cel.Row).Row, Range(col & cel.Row).Column + 1) = 1
'MsgBox (charge)
Else
cel.Value = cel.Value & " " & rapport & "-" & pays
Sheets("Consultants").Cells(Range(col & cel.Row).Row, Range(col & cel.Row).Column + 1) = Sheets("Consultants").Cells(Range(col & cel.Row).Row, Range(col & cel.Row).Column + 1) + charge
charge = 0
End If
End If
End If
End If
End If
'MsgBox (charge)
Next cel
Call Table_charge
End Sub
Si quelqu'un a une idée sur ce problème.
Merci pour votre coup de main!
Zè