Microsoft 365 Boutons

Hugo82

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

patricktoulon

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

XLDnaute Barbatruc
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 ;)
demo.gif
 

Pièces jointes

  • Tableau annuelGG.xlsm
    30.8 KB · Affichages: 1

Hugo82

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

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

XLDnaute Nouveau
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...✌️
 

Gégé-45550

XLDnaute Accro
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.
  1. 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
  2. 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
  3. 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.
  4. 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

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

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

Pièces jointes

  • Tableau annuelGG.xlsm
    31.3 KB · Affichages: 1

Discussions similaires

Statistiques des forums

Discussions
312 534
Messages
2 089 386
Membres
104 153
dernier inscrit
Pascalmorin