Aide finalisation d'un doc avec case à cocher

[Madeinsud]

Bonsoir, j'ai un petit problème sur une feuille avec macro que je suis en train de créer j'ai essayé de copier un petit code que j'ai adapté d'une précédente requête il y a quelques jours. Mais dans une de mes colonne quand je clique sur les cases à cocher il y a un i qui apparait systématiquement est-il possible de l'enlever ?

J'aimerai aussi grâce aux boutons et aux valeur qui leur sont attribués pouvoir faire apparaître un total dans une cellule ?

Voir ma création en PJ

Merci d'avance pour votre aide.

olivier

PS : j'essaye petit à petit de comprendre comment fonctionne le VBA avec les autres post et la logique des codes je suis donc un novice confirmé 😀

 

[Madeinsud]

Re : Aide finalisation d'un doc avec case à cocher

Le fichier excel en PJ

 

[PMO2]

Re : Aide finalisation d'un doc avec case à cocher

Bonjour,

Malheureusement votre pièce jointe ne comporte aucune macro car il est de type xlsx
Transmettez-nous un fichier de type xlsm

 

[Madeinsud]

Re : Aide finalisation d'un doc avec case à cocher

Oups le boulet du jour c'est moi !!!!

J'ai réussi a enlever les i donc ma seule question concerne maintenant le fait de pouvoir faire apparaître la note automatiquement dans les cellules de E3 à E7; E9 à E19.... que j'aurai au préalable fusionnées afin d'avoir le nombre de points par item en jaune qui s’affiche sous la forme ../5 pour B1 et B2 ../10 pou B2 et B3.

D'avance merci

Olivier

 

[PMO2]

Re : Aide finalisation d'un doc avec case à cocher

Bonjour,

Copiez le code suivant dans la fenêtre de code de la feuille concernée

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim cellule As Range
'---
If Not Intersect(Target, Range("B3:C7,B9:C19,B21:C25,B27:C30")) Is Nothing Then
For Each cellule In Range(Cells(Target.Row, 2), Cells(Target.Row, 3))
  cellule.Value = Chr(161)
Next cellule
Target.Value = Chr(164)
Cells(Target.Row, 4).Select
End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim R As Range
Dim R2 As Range
Dim C As Range
Dim k&
Dim cpt&
Dim x#
Dim Total#
Dim Plages As Variant
'--- Les plages concernées ---
Plages = Array("C3:C7", "C9:C19", "C21:C25", "C27:C30")
'--- Boucle sur chaque plage ---
For k& = LBound(Plages) To UBound(Plages)
  Set R = Range(Plages(k&))
  If Not Application.Intersect(Target, R) Is Nothing Then
    cpt& = 0
    '--- Les cellules valides ---
    For Each C In R
      If C = Chr(164) Then
        cpt& = cpt& + 1
      End If
    Next C
    '--- Les points en colonne E (Bx / 5) ---
    Set R2 = R.Offset(-1, 2).Cells(1, 1)
    Points# = CDbl(Mid(R2, InStr(1, R2, "/") + 1))
    '--- Partage des notes et inscription du tirage ---
    Set R2 = R.Offset(0, 2).Cells(1, 1)
    x# = cpt& * (Points# / R.Rows.Count)
    x# = Round(x#, 2)
    Application.EnableEvents = False
    R2 = CStr(x#) & Chr(160) & "/" & Chr(160) & CStr(Points)
    Application.EnableEvents = True
  End If
Next k&
'--- Total ---
For k& = LBound(Plages) To UBound(Plages)
  Set R = Range(Plages(k&)).Offset(0, 2).Cells(1, 1)
  Total# = Total# + CDbl(Mid(R, 1, InStr(1, R, Chr(160)) - 1))
Next k&
'--- Inscription du total en E31 ---
Application.EnableEvents = False
Range("E31") = Total#
Application.EnableEvents = True
End Sub