Microsoft 365 Boutons

Hugo82 · 19 Janvier 2024

Bonjour, je souhaiterais me créer un fichier excel avec le noms de mes patients avec 2 boutons pour mon suivi de facturation
un bouton "Facturé"
un bouton " Payé"
Avec un remplissage de la cellule en couleurs pour chacune d'elles en fonction du clique de bouton ( exemple: je clique sur facturé et cela me colorie la case choisie en couleur "vert")

Merci d'avance

Hugo82 · 21 Janvier 2024

Phil69970 à dit:
Bonjour @Hugo82 et @Gégé-45550

@Hugo82

Et si tu fournissais le MDP du fichier ce serait plus simple !!

Pour info tant que nous ne pouvons pas accéder au code VBA nous ne pourrons que difficilement t'aider.

Je n'ai pas mis de code...donc je ne le connais pas si c'est le cas
je deviens dingue lol

Gégé-45550 · 21 Janvier 2024

Hugo82 à dit:
Je n'ai pas mis de code...donc je ne le connais pas si c'est le cas
je deviens dingue lol

Une proposition avec un fichier "tout neuf"
Cordialement

Hugo82 · 21 Janvier 2024

Oui c'est ce principe là TOP Merci beaucoup vraiment
C'étai la partie codage que je n'arrivais pas à faire.
J'ai besoin du code pour pouvoir l'utiliser dans le futur?? pour la partie vba??
Car je souhaite le faire pour chaque année
En tout cas merci énormément

patricktoulon · 21 Janvier 2024

Bonjour à tout les deux
1 ° je vois des numligne et numcolonne qui servent à rien dans le code
2 °il n'y a pas de possibilité de réparer si on a clické par erreur

Perso je vois les choses plus simplement
on resize un range A5 jusqu'au slup de la colonneA que l'on resize à 365 colonnes(d'après ce que je vois sur la feuille
et dans mes bouton je gère la méprise i(nvolontaire ou pas )
terminé

VB:

Option Explicit

Private Sub CmdBtn_Facturé_Click()
    Dim rng As Range, Rep As VbMsgBoxResult
    Set rng = Range("A5:A" & Cells(Rows.Count, "A").End(xlUp).Row).Resize(, 365)
    If Not Intersect(ActiveCell, rng) Is Nothing Then
        If ActiveCell.Interior.Color = &H80FF& Then
            Rep = MsgBox("Etes  sur de vouloir la dépointer des factures", vbYesNo)
            If Rep = vbYes Then ActiveCell.Interior.Color = xlNone
        Else
            ActiveCell.Interior.Color = &H80FF&
        End If
    End If
End Sub

Private Sub CmdBtn_Payé_Click()
    Dim rng As Range, Rep As VbMsgBoxResult
    Set rng = Range("A5:A" & Cells(Rows.Count, "A").End(xlUp).Row).Resize(, 365)
    If Not Intersect(ActiveCell, rng) Is Nothing Then
        If ActiveCell.Interior.Color = &H80FF& Then
            Rep = MsgBox("Etes  sur de vouloir la dépointer des payés", vbYesNo)
            If Rep = vbYes Then ActiveCell.Interior.Color = xlNone
        Else
            ActiveCell.Interior.Color = &HC000&
        End If
    End If
End Sub

c'est pas compliqué

@+ patrick

patricktoulon · 21 Janvier 2024

et j'irais même plus loin
quand tu sera au mois X qu'il faudra que tu selectionne ta cellule et que tu rescrolle ta feuille pour revenir au boutons et bien quand tu l'aura fait 4/5 fois ton fichier tu le jettera à la poubelle tellement ça te gonflera
alors que si on fige les volet en placant intelligemment les boutons , ca devient tout de suite plus simple
après je dis ca je dis rien moi

Hugo82 · 21 Janvier 2024

patricktoulon à dit:
et j'irais même plus loin
quand tu sera au mois X qu'il faudra que tu selectionne ta cellule et que tu rescrolle ta feuille pour revenir au boutons et bien quand tu l'aura fait 4/5 fois ton fichier tu le jettera à la poubelle tellement ça te gonflera
alors que si on fige les volet en placant intelligemment les boutons , ca devient tout de suite plus simple
après je dis ca je dis rien moi
Regarde la pièce jointe 1188901

Bonjour, merci pour ces modifications qui sont effectivement plus pratique cependant sur le fichier que vous avez transmis les boutons ne fonctionnent pas...quand on clique dessus rien ne se passe?
est ce normal?

Merci

patricktoulon · 21 Janvier 2024

RE
oui comme j'ai décalé il falait corriger le resize

VB:

Option Explicit

Private Sub CmdBtn_Facturé_Click()
    Dim rng As Range, Rep As VbMsgBoxResult
    Set rng = Range("C5:C" & Cells(Rows.Count, "B").End(xlUp).Row).Resize(, 365)
     If Not Intersect(ActiveCell, rng) Is Nothing Then
        If ActiveCell.Interior.Color = &H80FF& Then
            Rep = MsgBox("Etes  sur de vouloir la dépointer des factures", vbYesNo)
            If Rep = vbYes Then ActiveCell.Interior.Color = xlNone
        Else
            ActiveCell.Interior.Color = &H80FF&
        End If
    End If
End Sub

Private Sub CmdBtn_Payé_Click()
    Dim rng As Range, Rep As VbMsgBoxResult
    Set rng = Range("C5:C" & Cells(Rows.Count, "B").End(xlUp).Row).Resize(, 365)
    If Not Intersect(ActiveCell, rng) Is Nothing Then
        If ActiveCell.Interior.Color = &H80FF& Then
            Rep = MsgBox("Etes  sur de vouloir la dépointer des payés", vbYesNo)
            If Rep = vbYes Then ActiveCell.Interior.Color = xlNone
        Else
            ActiveCell.Interior.Color = &HC000&
        End If
    End If
End Sub

Hugo82 · 21 Janvier 2024

patricktoulon à dit:

RE
oui comme j'ai décalé il falait corriger le resize

VB:

Option Explicit

Private Sub CmdBtn_Facturé_Click()
    Dim rng As Range, Rep As VbMsgBoxResult
    Set rng = Range("C5:C" & Cells(Rows.Count, "B").End(xlUp).Row).Resize(, 365)
     If Not Intersect(ActiveCell, rng) Is Nothing Then
        If ActiveCell.Interior.Color = &H80FF& Then
            Rep = MsgBox("Etes  sur de vouloir la dépointer des factures", vbYesNo)
            If Rep = vbYes Then ActiveCell.Interior.Color = xlNone
        Else
            ActiveCell.Interior.Color = &H80FF&
        End If
    End If
End Sub

Private Sub CmdBtn_Payé_Click()
    Dim rng As Range, Rep As VbMsgBoxResult
    Set rng = Range("C5:C" & Cells(Rows.Count, "B").End(xlUp).Row).Resize(, 365)
    If Not Intersect(ActiveCell, rng) Is Nothing Then
        If ActiveCell.Interior.Color = &H80FF& Then
            Rep = MsgBox("Etes  sur de vouloir la dépointer des payés", vbYesNo)
            If Rep = vbYes Then ActiveCell.Interior.Color = xlNone
        Else
            ActiveCell.Interior.Color = &HC000&
        End If
    End If
End Sub

D'accord merci
Du coup je recopie ce code dans le général ?
Je m'y remets doucement et j'ai encore bcp de mal...

patricktoulon · 21 Janvier 2024

re
dans le module de la feuille là où il est actuellement
tu remplace tout bien sur
tiens le fichier

Hugo82 · 21 Janvier 2024

Merci pour le fichier
C'est cool
Merci pour votre entraide et de votre indulgence

Gégé-45550 · 21 Janvier 2024

patricktoulon à dit:

RE
oui comme j'ai décalé il falait corriger le resize

VB:

Option Explicit

Private Sub CmdBtn_Facturé_Click()
    Dim rng As Range, Rep As VbMsgBoxResult
    Set rng = Range("C5:C" & Cells(Rows.Count, "B").End(xlUp).Row).Resize(, 365)
     If Not Intersect(ActiveCell, rng) Is Nothing Then
        If ActiveCell.Interior.Color = &H80FF& Then
            Rep = MsgBox("Etes  sur de vouloir la dépointer des factures", vbYesNo)
            If Rep = vbYes Then ActiveCell.Interior.Color = xlNone
        Else
            ActiveCell.Interior.Color = &H80FF&
        End If
    End If
End Sub

Private Sub CmdBtn_Payé_Click()
    Dim rng As Range, Rep As VbMsgBoxResult
    Set rng = Range("C5:C" & Cells(Rows.Count, "B").End(xlUp).Row).Resize(, 365)
    If Not Intersect(ActiveCell, rng) Is Nothing Then
        If ActiveCell.Interior.Color = &H80FF& Then
            Rep = MsgBox("Etes  sur de vouloir la dépointer des payés", vbYesNo)
            If Rep = vbYes Then ActiveCell.Interior.Color = xlNone
        Else
            ActiveCell.Interior.Color = &HC000&
        End If
    End If
End Sub

Bonjour patricktoulon, bien vu mais tu es allé un peu vite et tu ne t'es sans doute pas relu.

Il n'y a aucune raison de poser les noms des clients en colonne B qui correspond au 1er janvier (pourquoi ne pourrait-on pas facturer ou payer le 1er janvier ?), donc ils seraient plus opportunément placés en colonne A, ce qui entraîne une correction du .SplitColumn de Macro1
Il n'est pas logique de faire commencer le Range en ligne 5 car c'est la ligne des dates, ils doit commencer en ligne 6, me semble-t-il
2024 étant bissextiles, le resize doit se faire sur 366 au lieu de 365 mais, du coup, l'année prochaine et toutes celles qui ne seront pas bissextiles, le resize devra être corrigé ... d'où l'intérêt de rechercher la dernière colonne non vide de la ligne 5 pour le resize.
Dans la Sub 'CmdBtn_Payé', la ligne 'If ActiveCell.Interior.Color = &H80FF& Then' est fausse, la couleur n'est pas bonne, la bonne couleur est &HC000&

Perso, je modifierais a minima les deux macros ainsi :

VB:

Private Sub CmdBtn_Facturé_Click()
    Dim rng As Range, Rep As VbMsgBoxResult
    Set rng = Range("B6:B" & Cells(Rows.Count, "A").End(xlUp).Row).Resize(, 366)
     If Not Intersect(ActiveCell, rng) Is Nothing Then
        If ActiveCell.Interior.Color = &H80FF& Then
            Rep = MsgBox("Etes  sur de vouloir la dépointer des factures", vbYesNo)
            If Rep = vbYes Then ActiveCell.Interior.Color = xlNone
        Else
            ActiveCell.Interior.Color = &H80FF&
        End If
    End If
End Sub

Private Sub CmdBtn_Payé_Click()
    Dim rng As Range, Rep As VbMsgBoxResult
    Set rng = Range("B6:B" & Cells(Rows.Count, "A").End(xlUp).Row).Resize(, 366)
    Debug.Print rng.Address
    If Not Intersect(ActiveCell, rng) Is Nothing Then
        If ActiveCell.Interior.Color = &HC000& Then
            Rep = MsgBox("Etes  sur de vouloir la dépointer des payés", vbYesNo)
            If Rep = vbYes Then ActiveCell.Interior.Color = xlNone
        Else
            ActiveCell.Interior.Color = &HC000&
        End If
    End If
End Sub

et je pense que je corrigerais le resize pour tenir compte des années bissextiles.
Bien amicalement et avec un grand respect pour tes immenses connaissances et ta promptitude à toujours donner un coup de main à ceux qui en ont besoin.

patricktoulon · 21 Janvier 2024

re oui les nom en, B je suis pas d'accords pour la simple raison que le 01/01/xxxx c'est ferrié
il es rare que l'on s'occupe des affaire courante un year day

cela dit logarithmiquement parlant ca se discute
et puis j'ai fait avec le tableau qui était déja fait
par contre tu n'a pas corrigé le endxlup sur B et non sur A
les noms et date doivent toujours etres visibles

patricktoulon · 21 Janvier 2024

en laissant les noms en A

VB:

Option Explicit

Private Sub CmdBtn_Facturé_Click()
    Dim rng As Range, Rep As VbMsgBoxResult
    Set rng = Range("b5:b" & Cells(Rows.Count, "a").End(xlUp).Row).Resize(, CDate("31/12/2024") - CDate("01/01/2024") + 1)
    If Not Intersect(ActiveCell, rng) Is Nothing Then
        If ActiveCell.Interior.Color = &H80FF& Then
            Rep = MsgBox("Etes  sur de vouloir la dépointer des factures", vbYesNo)
            If Rep = vbYes Then ActiveCell.Interior.Color = xlNone
        Else
            ActiveCell.Interior.Color = &H80FF&
        End If
    End If
End Sub

Private Sub CmdBtn_Payé_Click()
    Dim rng As Range, Rep As VbMsgBoxResult
    Set rng = Range("b5:b" & Cells(Rows.Count, "a").End(xlUp).Row).Resize(, CDate("31/12/2024") - CDate("01/01/2024") + 1)
    If Not Intersect(ActiveCell, rng) Is Nothing Then
        If ActiveCell.Interior.Color = &H80FF& Then
            Rep = MsgBox("Etes  sur de vouloir la dépointer des payés", vbYesNo)
            If Rep = vbYes Then ActiveCell.Interior.Color = xlNone
        Else
            ActiveCell.Interior.Color = &HC000&
        End If
    End If
End Sub

patricktoulon · 21 Janvier 2024

en faisant avec datediff plus de probleme pour les Années bissextiles le calcul se fait tout seul

Microsoft 365 Boutons

Hugo82

XLDnaute Nouveau

Hugo82

XLDnaute Nouveau

Gégé-45550

XLDnaute Accro

Pièces jointes

Hugo82

XLDnaute Nouveau

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Pièces jointes

Hugo82

XLDnaute Nouveau

patricktoulon

XLDnaute Barbatruc

Hugo82

XLDnaute Nouveau

patricktoulon

XLDnaute Barbatruc

Pièces jointes

Hugo82

XLDnaute Nouveau

Gégé-45550

XLDnaute Accro

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Pièces jointes

patricktoulon

XLDnaute Barbatruc

Discussions similaires