Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2016 affectation fonction à CheckBox VBA

choce

XLDnaute Nouveau
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()
VB:
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

Code:
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

XLDnaute Barbatruc
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
VB:
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
 
Dernière édition:

patricktoulon

XLDnaute Barbatruc
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
VB:
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
 
Dernière édition:

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…