Bouton spécial

Bonsoir à tous,

j'essaye de résoudre un problème qui me paraît assez compliqué. Je ne sais pas si c possible de trouver une solution, mais je tente ma chance quand même.

J'ai créé un calendrier 2017. Dans ce calendrier j'ai un bouton devant chaque semaine qui me permet de comptabiliser l'achalandage par semaine, donc d'incrémenter + 1 dans la cellule. Seulement ce que j'ai envi de réaliser c l'achalandage par jour. Vous comprendrez que créer 365 bouton c pas très intelligent. Donc l'idéal ca serait d'avoir comme exemple cellule B6 un petit espace ou je pourrais mettre mon achalandage de la journée et clicker directement sur la cellule correspondante à ma date du jour pour comptabiliser celui-ci. si c possible ca serait génial, sinn selon vous qu'elle serait la meilleur solution ?

Merci d'Avance pour votre temps!

Bonjour,

Pourquoi ne pas utiliser le double clic pour incrémenter de 1 ? Une piste, à mettre dans le module de la feuille :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    If Not Intersect(Application.Union(Range("B5:H10"), _
                                       Range("K5:Q10"), _
                                       Range("T5:Z10"), _
                                       Range("AC5:AI10"), _
                                       Range("B14:H19"), _
                                       Range("K14:Q19"), _
                                       Range("T14:Z19"), _
                                       Range("AC14:AI19"), _
                                       Range("B22:H27"), _
                                       Range("K22:Q27"), _
                                       Range("T22:Z27"), _
                                       Range("AC22:AI27")), Target) Is Nothing Then

        Target.Value = Target.Value + 1
        Cancel = True 'pour éviter d'entrée en mode saisie (curseur dans la cellule)

    End If

End Sub

salut Theze,

Merci pour ta réponse, est ce qu'il y'a moyen de générer le + 1 dans une zone texte au sein de ma cellule, car autrement je doit me taper toute les dates ds chaque cellule dans une zone texte. si j'utilise le double click la valeur est générée dans la cellule et remplace donc ma date.

Bonjour,

insère plutôt des lignes pour tes compteurs.

Excel n'aime vraiment pas avoir trop d'objets sur une feuille.

Et tu pourrais mettre tes dates en colonne, là tu as un truc ingérable. Il faut choisir entre le beau et l'efficace.

eric

Pour incrémenter dans ta zone de texte :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    Dim S As Shape

    If Not Intersect(Application.Union(Range("B5:H10"), _
                                       Range("K5:Q10"), _
                                       Range("T5:Z10"), _
                                       Range("AC5:AI10"), _
                                       Range("B14:H19"), _
                                       Range("K14:Q19"), _
                                       Range("T14:Z19"), _
                                       Range("AC14:AI19"), _
                                       Range("B22:H27"), _
                                       Range("K22:Q27"), _
                                       Range("T22:Z27"), _
                                       Range("AC22:AI27")), Target) Is Nothing Then

        Set S = ActiveSheet.Shapes("ZoneTexte 1")

        If S.TextFrame.Characters.Caption = "" Then S.TextFrame.Characters.Caption = 0

        S.TextFrame.Characters.Caption = CLng(S.TextFrame.Characters.Caption) + 1

        Cancel = True 'pour éviter d'entrée en mode saisie (curseur dans la cellule)

    End If

End Sub

Merci Theze c vraiment ce que je recherche à faire , il reste une manipulation à réaliser pour que ca soit parfait, la maintenant quand je click sur n'importe quelle cellule j'ai mon + 1 dans ma zone texte B6, si je veux que chaque click dans une cellule précise me rajoute mon +1 dans la zone texte de la même cellule, est ce que c possible ?

Bonjour,

Il est très difficile de connaître quelle est la zone de texte située sur une cellule sans construire une usine à gaz !

Je te propose une autre solution, inscrire entre parenthèses la valeur incrémentée dans la cellule au dessus du jour. Le code, si il n'existe pas encore de chiffre entre parenthèses, le crée avec la valeur 1, si il existe déjà, l'incrémente de 1 puis mets la valeur en rouge et en gras :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    Dim Pos1 As Integer
    Dim Pos2 As Integer
    Dim Valeur As Integer
    Dim Jour As Integer

    If Not Intersect(Application.Union(Range("B5:H10"), _
                                       Range("K5:Q10"), _
                                       Range("T5:Z10"), _
                                       Range("AC5:AI10"), _
                                       Range("B14:H19"), _
                                       Range("K14:Q19"), _
                                       Range("T14:Z19"), _
                                       Range("AC14:AI19"), _
                                       Range("B22:H27"), _
                                       Range("K22:Q27"), _
                                       Range("T22:Z27"), _
                                       Range("AC22:AI27")), Target) Is Nothing Then

        If InStr(Target.Value, "(") = 0 Then Target.Value = "(0)" & Chr(10) & Chr(10) & Target.Value

        'recherche les positions des deux parenthèses
        Pos1 = InStr(Target.Value, "(")
        Pos2 = InStr(Target.Value, ")")

        'en extrait la valeur située entre elles
        Valeur = CInt(Mid(Target.Value, Pos1 + 1, Pos2 - Pos1 - 1)) + 1

        'récupère le jour
        Jour = Split(Target.Value, Chr(10) & Chr(10))(1)

        'reconstruit et entre le tout dans la cellule
        Target.Value = "(" & Valeur & ")" & Chr(10) & Chr(10) & Jour

        'recherche à nouveau (dans le cas où on vient de passer par exemple de 9 à 10
        Pos1 = InStr(Target.Value, "(")
        Pos2 = InStr(Target.Value, ")")

        'mets la valeur en couleur rouge et en gras
        With Target.Characters(Pos1 + 1, Pos2 - Pos1 - 1).Font
            .ColorIndex = 3
            .Bold = True
        End With

        Cancel = True 'pour éviter d'entrée en mode saisie (curseur dans la cellule)

    End If

End Sub

Merci Theze, j'apprécie bcp ton aide.

Rechercher des sujets similaires à "bouton special"