XL 2016 affectation fonction à CheckBox VBA

[choce]

Bonjour,
J'ai réalisé une macro qui vient créer des cases à cocher dans la case de droite pour chaque cellule contenant du texte. Cela permet d'avoir un suivi des documents achevés ( ceux-ci changent pour chaque projet)

J'aimerais avoir un suivi de quand le document est achevé, pour cela dans la macro je lie l'état de chaque case à une cellule différente et je souhaiterais avoir à droite de l'état la date à laquelle la case a été cochée.

Pour cela il existe une fonction toute simple avec =Date()

Function WriteDate(cell)
     Cells(cell, 30) = Date
End Function

J'aimerais affecter cette fonction à chaque case à cocher lorsque je les crée <!>en faisant changer le paramètre d'entré à savoir dans quelle cellule on va renseigner la date
Or il est impossible d'affecter une fonction à la case à cocher, seul un Sub est possible

Sub AddcheckboxesPerso()
Dim cell, LRow As Single
Dim chkbx As CheckBox
Dim MyLeft, MyTop, MyHeight, MyWidth As Double

Doc_cell = 5 'F
Check_cell = 6 'G
St_cell_link = 10
Application.ScreenUpdating = False


For col = 1 To 10
    Doc_cell = Doc_cell + 1
    Check_cell = Check_cell + 1
    For cell = 16 To 22 
        If Cells(cell, Doc_cell).Value <> "" Then
            MyLeft = Cells(cell, Check_cell).Left
            MyTop = Cells(cell, Check_cell).Top
            MyHeight = Cells(cell, Check_cell).Height
            MyWidth = Cells(cell, Check_cell).Width
            ActiveSheet.CheckBoxes.Add(MyLeft, MyTop, MyWidth, MyHeight).Select
            With Selection
                .Caption = ""
                .Value = xlOff
                .Display3DShading = False
                .LinkedCell = ActiveWorkbook.Worksheets("Feuil2").Cells(St_cell_link, 29).Address  'AC 10
                .OnAction = "compter" 'affecte la macro ici l'ideal serait de mettre "WriteDate(Cell+1)" or ce n'est pas possible <!>
            End With
            St_cell_link = St_cell_link + 1
        End If
    Next cell
Next col
Application.ScreenUpdating = True

End Sub

Merci d'avance pour vos précieuses réponses et conseils

 

[Staple1600]

Bonsoir le fil,

Un petit test avec des cases à cocher (contrôles Formulaire)
Je créé N cases à cocher à laquelle j'affecte la macro ci-dessous

Sub checkbox()
Dim cbx As Shape
Set cbx = ActiveSheet.Shapes(Application.Caller)
Select Case cbx.Type
Case 8
cbx.TopLeftCell.Offset(1, 1) = Date
Case Else
'
End Select
End Sub

EDITION: Bonjour patricktoulon

 

[patricktoulon]

re
bonjour

.OnAction = "compter" 'affecte la macro ici l'ideal serait de mettre "WriteDate(Cell+1)" or ce n'est pas possible <!>

mais bien sur que si c'est possible d'injecter Xargument avec ".Onaction

quelques exemples
comme ca vite fait

Sub test1()
'exemple avec 1 argument ecrit en dur dans l'apel
Sheets(1).Shapes(1).OnAction = "'mamacro " & """toto""" & "'"
End Sub

Sub test1BIS()
'la meme que la TEST1 mais avec l'argument variabilisé
machin = "toto"
Sheets(1).Shapes(1).OnAction = "'mamacro " & Chr(34) & machin & Chr(34) & "'"
End Sub


Sub test2()
'exemple avec plusieurs  arguments ecrit en dur dans l'apel
Sheets(1).Shapes(1).OnAction = "'mamacro2 " & Chr(34) & "toto "","" titi "",""  riffifi ""'"
End Sub

Sub test2BIS()
'LA MEME QUE LA test2 MAIS AVEC   LES!!!!! memes arguments mais variabilisés
machin1 = "toto"
machin2 = "titi"
machin3 = "riffifi"
  Sheets(1).Shapes(1).OnAction = "'mamacro2 " & Chr(34) & machin1 & """,""" & machin2 & """,""" & machin3 & "'"
End Sub

Sub mamacro(argument)
MsgBox argument
End Sub

Sub mamacro2(argument1, argument2, argument3)
MsgBox argument1 & vbCrLf & argument2 & vbCrLf & argument3
End Sub

il est bien entendu possible de mettre ces arguments en optional
il est bien évident aussi qu'il est hors de question que l'argument soit un object (range ou autre) vu que l'argumentation c'est du string
cela dit rien empêche d'injecter l'adresse d'une cellule

 

[Staple1600]

Bonjour à toi aussi patricktoulon...

 

[patricktoulon]

bonjour staple1600
il me semble te l'avoir dit tout a l'heure dans un autre post non ?

 

[Staple1600]

Re

patricktoulon
Encore faut-il que j'ai lu l'autre fil
L'usage c'est de saluer l'intervenant dans le fil où il se trouve
(vœux pieux)

 

[patricktoulon]

re
une autre methode sans macro
si ce checkbox masque une cellule on pourrait se servir de la propriété link et lui donner l'adresse de cette dite cellule
et utiliser une formule pour ta cellule date