XL 2013 incrémenté avec SpinBuutton formule ayant plusieurs référence & DoubleClick masque ligne verrouillé

[MadMax97]

Bonjour à tous,

Après plusieurs manip et amélioration de mon fichier de statistique physique, je voudrais avoir vos lumières, vos aides et explication sur deux problèmes que je n'arrive pas à solutionner ,

1 - Incrémenter une Formule avec SpinButtonStats :
>Le résultat souhaité serait que SpinButtonStats puisse augmenter ou diminuer avec un pas de 1 (max & Min), uniquement les valeurs des cellules référencer dans chaque formule "Notes" situé dans la partie en vertes "Stats", tout en gardant intact sa fonction initiale avec les cellules "Ref.Phy", car le problème que je rencontre est que dès que je clique sur le SpinButton c'est le résultat final de la formule qui s’incrémente au lieu que ce des valeurs des cellules sources identifier dans la formule.

Exemples du résultat attendu :
En G4 sont référencés dans la formule "AQ4" ayant pour valeur 77 et "AF4" ayant pour valeur 79, l'incrémentation doit modifier les deux valeurs en même temps : 77 et 79 > +1 : 78 et 80 ou -1 : 76 et 78

Question : Faudrait'il pas créer un autre SpinButton qu'on positionnerait en "F1" pour éviter un quelconque conflit de fonctionnement entre les deux zones "Notes" & "Ref.Phy"?

2 - Masquer et démasquer des lignes :
> Qu'une ligne soit verrouiller ou non, je souhaiterais la masquer avec son "CheckBoxPers" par un double clique sur le numéro de cette ligne (ex:"4").
> Par contre en cliquant sur le bouton "Dem. All Lignes" j'aimerais faire apparaître à nouveau toutes les lignes qui auraient été masquer, en tenant compte que toute ligne verrouiller (en verte) qui aurait été masquer, devra rester tel quel une fois que'elle réapparaîtrait,"CheckBoxPers" compris . un peu le même principes qu'ave le bouton "Dev. All Lignes" qui lui déverrouille toutes les lignes verrouiller par le "CheckBoxPers" de la ligne liée.

Trouvez mon fichier ci-joint, Je suis a l'écoute de toute proposition, amélioration envisageable,
si vous pouvez m'aider je vous en remerciait beaucoup
Bien à vous

 

[JHA]

Bonjour à tous,

un début de réponse pour le SpinButton qui est lié à la cellule "D1" avec une formule en "E1" et résultat en "E2"

JHA

 

[job75]

Bonjour MadMax97, JHA,

La macro du SpinButton :

Private Sub SpinButtonStats_Change()
Dim c As Range
Protect "", UserInterfaceOnly:=True 'protection sans mot de passe
If ActiveCell.Formula Like "=ROUND(*)" Then
    For Each c In ActiveCell.DirectPrecedents 'Antécédents
        c = c + SpinButtonStats
    Next
End If
SpinButtonStats = 0
End Sub

Double-clic pour masquer une ligne :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Protect "", UserInterfaceOnly:=True 'protection sans mot de passe
OLEObjects.Placement = 1 'déplace et dimensionne les objets avec les cellules
If Target.Row > 3 Then Cancel = True: Target.EntireRow.Hidden = True
End Sub

La macro du 2ème CommandButton :

Private Sub CommandButtonDem_Click()
Protect "", UserInterfaceOnly:=True 'protection sans mot de passe
Rows.Hidden = False
End Sub

Fichier joint.

Bonne journée.

 

[MadMax97]

Bonjour job75,

Au top, j'ai pris une sacré claque, je suis agréablement impressionné, car c'est tout a fait le résultat souhaité, sa fessait 4 jours que je bûchais sur ses problèmes, et avoue que j’étais loin d'y arriver,
mais toi tu m'as apporter tes lumières et je tant remercie, car j'en apprend plus, grâce au quelque optimisations que tu as apporter au fichier ,

j'aurai quand même deux question à poser:

- le spinbutonstats exécute bien la tache voulu sur les cellules Notes de 1 a 6, mais par contre je me rend compte qu'il n'incrémente plus individuellement n'importe quel cellules Ref.Phy allant de N à AX, qui est une simple incrémentation de valeurs, sans formule,
> Comme puis-je retrouver cette simple fonction en plus de celle apportée ?

- Au double-clic j'ai ajouter le code suivant :

If Not Application.Intersect(Target, Range("M4")) Is Nothing Then
    [N4:AX4].ClearContents
End If

fonction pour vidé une plage souhaitée en double-cliquant sur le symbole > se trouvant dans la colonne M, jusque la tout fonctionne bien,
mais le problème que je rencontre, est que du coup, le masquage ce fait aussi,
> Comment faire pour que les deux puissent fonctionner indépendamment en attribuant par exemple le masquage en double-cliquant sur chaque numéro ce trouvant dans la colonne F, cela sans qu'ils interférèrent entre eux ?

Fichier joint

Bien à vous

 

[job75]

La macro du SpinButton complétée :

Private Sub SpinButtonStats_Change()
Dim c As Range
Protect "", UserInterfaceOnly:=True 'protection sans mot de passe
If ActiveCell.Formula Like "=ROUND(*)" Then
    For Each c In ActiveCell.DirectPrecedents 'Antécédents
        c = c + SpinButtonStats
    Next
ElseIf IsNumeric(CStr(ActiveCell)) Then
    ActiveCell = ActiveCell + SpinButtonStats
End If
SpinButtonStats = 0
End Sub

Pour le double-clic ne modifiez pas ma macro et utilisez le clic droit pour effacer : Worksheet_BeforeRightClick.

 

[MadMax97]

Hello job75,

Ayant été un peu soufrant ses derniers jours, désolée de répondre que maintenant , je vous remercies grandement pour vos aides,
tout fonctionne à merveilles, j'en ai profité pour apporter quelques modification au fichier,
tout particulièrement une sur la quel je patoche beaucoup,

celle de faire remonter toute les lignes d'une range en fessant abstraction des ligne vide, jusque la tout va bien, des lors que la première ligne de la range est vide la macro utilisé le permet, sauf que si c'est la seconde ligne de la range serait vide par contre aucune remonter de lignes s'effectue et la est mon problème,

je souhaiterai que la remonter se fasse quelque sois la ligne qui serait vide ou remplie, première seconde ou avant dernière de la range.

Avant toute éventuelle proposition de solution, j'aimerais si possible qu'on m'explique a quel niveau cela coince dans ma macro, je ne demande pas un cours mais au moins qu'on explications pour que j'y vois plus clairs, histoire d'assimilé un peu plus de chose.

> Question 1 : Quand je remplace la partie : tbc = Array ("N", "O..........") par : tbc = Range("N5:AX7"), pourquoi, ais-je un message :
Erreur d’exécution 9, comment simplifiétout cela ou bien ne serait ce pas la bonne syntaxe.

voici la macro utilisé :

Sub remonterSiLignePlayerVide()
Dim lga As Long, lgn As Long, ncl As Integer, tbc
    tbc = Array("N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", "AA", "AB", "AC", "AD", "AE", "AF", "AG", "AH", "AI", "AJ", "AK", "AL", "AM", "AN", "AO", "AP", "AQ", "AR", "AS", "AT", "AU", "AV", "AW", "AX", "AY", "AZ", "BA", "BB", "BC", "BD", "BE", "BF", "BG", "BH", "BI", "BJ", "BK", "BL", "BM", "BN", "BO", "BP", "BQ", "BR", "BS", "BT", "BU", "BV", "BW", "BX", "BY", "BZ", "CA", "CB", "CC", "CD", "CE", "CF", "CG", "CH", "CI", "CJ", "CK", "CL", "CM", "CN", "CO", "CP", "CQ", "CR", "CS", "CT", "CU", "CV", "CW", "CX", "CY", "CZ", "DA", "DB", "DC", "DD", "DE", "DF", "DG", "DH", "DI", "DJ", "DK", "DL", "DM", "DN", "DO", "DP", "DQ", "DR", "DS", "DT", "DU", "DV", "DW", "DX", "DY", "DZ", "EA")
    For ncl = 0 To UBound(tbc)
        lgn = 5
        For lga = 5 To Cells(Rows.Count, tbc(ncl)).End(xlUp).Row
            If Cells(lgn, tbc(ncl)) = "" And Cells(lga, tbc(ncl)) <> "" Then
                Cells(lgn, tbc(ncl)) = Cells(lga, tbc(ncl))
                Cells(lga, tbc(ncl)) = ""
                lgn = lgn + 1
            End If
        Next lga
    Next ncl
End Sub

> Question 2 : Est-il possible et si oui, comment faire que le CheckBox de déverrouillage de toutes lignes : CheckBoxDevAllLignes, puisse être coché lorsque qu'une ou toutes les lignes sont cochées (en quelque sorte en True) et inversement être décoché une fois qu'on clique à nouveau sur le CheckBoxDevAllLignes, (lui aussi en quelque sorte en False)

Fichier joint

Bien à vous

 

[job75]

Bonjour MadMax97, le forum,

1) Le clic droit sur les cellules en colonne M efface les lignes à droite et fait remonter les autres :

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Protect "", UserInterfaceOnly:=True 'protection sans mot de passe
Set Target = Intersect(Target, Range("M5:M" & Rows.Count))
If Target Is Nothing Then Exit Sub
Cancel = True
Application.ScreenUpdating = False
With Intersect(UsedRange, Range("N4:AX" & Rows.Count))
    .Columns(2).Insert xlToRight 'colonne auxiliaire
    .Columns(2) = 1
    Intersect(Target.EntireRow, .Cells) = "" 'effacement
    .Sort .Columns(2) 'tri pour grouper les vides en bas
    .Columns(2).Delete xlToLeft
End With
End Sub

2) Les codes des CheckBoxes sont un peu difficiles à bien comprendre :

Dim flag As Boolean 'mémorise la variable

Private Sub CheckBoxDevAllLignes_Click()
Dim o As OLEObject, coche As Boolean
If flag Then
    For Each o In OLEObjects
        If TypeName(o.Object) = "CheckBox" And o.Name <> "CheckBoxDevAllLignes" Then If o.Object Then coche = True
    Next
    CheckBoxDevAllLignes = coche
Else
    flag = True
    Application.ScreenUpdating = False
    For Each o In OLEObjects
        If TypeName(o.Object) = "CheckBox" And o.Name <> "CheckBoxDevAllLignes" Then o.Object = CheckBoxDevAllLignes
    Next
End If
flag = False 'RAZ
End Sub

Private Sub CheckBoxPers1_Click()
Protect "", UserInterfaceOnly:=True 'protection sans mot de passe
Range("RngPers1").Interior.ColorIndex = IIf(CheckBoxPers1, 4, xlNone)
Range("RngPers1").Locked = CheckBoxPers1
If flag Then Exit Sub
flag = True
CheckBoxDevAllLignes_Click
End Sub

'---etc---

Bonne journée.

 

[job75]

Je viens de revoir les codes de mon post précédent.

 

[job75]

Bonjour MadMax97, le forum,

Je n'aimais pas le SpinButton car le focus ne restait pas sur la cellule active.

Dans ce fichier (4) tous les contrôles ActiveX sont remplacés par des contrôles de formulaire :

Dim flag As Boolean 'mémorise la variable

Sub Case1_Click()
Dim c As Range, coche As Boolean
If flag Then
    For Each c In [A5:A7]
        If c Then coche = True
    Next
    [A4] = coche
Else
    [A5:A7] = [A4]
    flag = True
    Application.ScreenUpdating = False
    CaseX_Click
End If
flag = False 'RAZ
End Sub

Sub CaseX_Click()
Dim c As Range, P As Range
Protect "", UserInterfaceOnly:=True 'protection sans mot de passe
For Each c In [A5:A7]
    Set P = Intersect(c.EntireRow, [B:E,G:L,N:AX,AZ:BE,BG:BU])
    P.Interior.ColorIndex = IIf(c, 4, xlNone)
    P.Locked = c
Next
If flag Then Exit Sub
flag = True
Case1_Click
End Sub

Sub Compteur()
Dim c As Range
Protect "", UserInterfaceOnly:=True 'protection sans mot de passe
If ActiveCell.Formula Like "=ROUND(*)" Then
    For Each c In ActiveCell.DirectPrecedents 'Antécédents
        c = c + [M1] - 1
    Next
ElseIf IsNumeric(CStr(ActiveCell)) Then
    ActiveCell = ActiveCell + [M1] - 1
End If
[M1] = 1
End Sub

A+

 

[MadMax97]

Bonjour le Forum, job75,

Déplacement à l'étranger oblige, désolée de ne répondre que maintenant, merci grandement à job75 pour les aides apportées,
Lors de mon déplacement, j'en ai profiter pour tester le fichier, qui fonctionnent très bien, nickel chrome,

Pour des raisons de confort, j’aurai besoin d'aides sur deux modifications à apporter,

> La première si possible serait que le SpinButton générale puisse apparaître quelque soit la cellule activé, soit dans la cellules à coté de la valeur ou bien collé à cette cellule active, car il n’apparaît qu'en cellule M1, et voudrait aussi limiter l’incrémentation des Ref.Phy en Min : 0 et Max : 99, mais que cela ne puisse pas bloquer incrémentation par les Notes 1 à 6 qui devront continué à s'incrémenter même si lune des valeur cible de la formule venait à atteindre 99, il faudrait que les autre valeurs puissent augmenter indépendamment jusqu’à leur Max : 99 et ainsi de suite jusqu'a toutes est atteintes 99 qui donnerait une note générale de 99.

> La seconde serait que le bouton "Réinitialiser All Stats" en plus de sa fonction initiale d'effacement de toute les statistiques de toutes les ranges puisse réinitialisé tout les macros, en quelque sorte qui "Call" l'éventement "Réactiver toutes les lignes",
- c'est la que je bloque, car lorsque j'utilise la fonction Call une erreur d’exécution ce produit.

Fichier joint

Bien à vous

 

[job75]

Bonjour MadMax97,

Pour la 1ère question voyez dans ce fichier (5) les macros Compteur et Worksheet_SelectionChange.

Je ne comprends pas la 2ème question car il n'y a aucun problème pour appeler la macro ReacAllLignes.

A+

 

[MadMax97]

Bonjour job75,

Encore une fois, un grand merci, la partie compteur fonctionne tip top, rien a redire, le positionnement du SpinButton est parfait, et l'incrémentation min : 0 et Max : 99 est au poil, car la on a un vrai résultats final net et précis, fini les Notes globaux qui pouvaient être faussées par une Ref.Phy qui aurait dépassées les 100 voir plus.

Pour ce qui est de la deuxième demande, je voudrait simplement que le bouton "Réinitialiser toutes les Stats" puisse exécuter toutes les fonctions réunis, pour retrouver un fichier comme au premier jour :
- Effacer toute les valeurs des Ref.Phy ( Ce qu'il fait déjà très bien).
- Réactiver toutes les lignes qui seraient masquées.
- Décocher touts les CheckBox qui l’auraient étés pour qu'elle soient à nouveau déverrouiller.
Et, c'est la que je bloque, car dans le module 1, lorsque je fait appel à la fonction Call Case1_Click de la Feuill 1 par exemple, une erreur de compilation ce produit.

Bien à vous,
Que la Force du VBA soit avec vous.

 

[job75]

Bonjour MadMax97,

Case1_Click est dans un module de feuille, il faut donc préciser le module (CodeName) :

Sub RemiseZeroStats()
With Sheets("Stats")
    .Protect "", UserInterfaceOnly:=True 'protection sans mot de passe
    .Range("N5:AX" & .Rows.Count).ClearContents
    ReacAllLignes
    If .[A4] Then .[A4] = False: Run (.CodeName & ".Case1_Click") 'ou Feuil1.Case1_Click
End With
End Sub

Fichier (6).

A+