Aide finalisation d'un doc avec case à cocher

Madeinsud

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

Madeinsud

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

Pièces jointes

  • Grille CACES 1 avec macros.xlsm
    21.2 KB · Affichages: 45

PMO2

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

Pièces jointes

  • Grille CACES 1 avec macros_pmo.xlsm
    22 KB · Affichages: 33

Discussions similaires