Ma barre personnel lance 2 fois le .OnAction...

ZèBelini

XLDnaute Nouveau
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:

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!

 

Statistiques des forums

Discussions
312 848
Messages
2 092 779
Membres
105 533
dernier inscrit
TAF