Microsoft 365 Boutons

H

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
 
Trier par date Trier par votes
patricktoulon

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
 
Vote positif 0 Vote négatif
patricktoulon

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
Vote positif 0 Vote négatif
H

Hugo82

XLDnaute Nouveau
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
Cliquez pour agrandir...
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 :)
 
Vote positif 0 Vote négatif
patricktoulon

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
 
Vote positif 0 Vote négatif
H

Hugo82

XLDnaute Nouveau
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
Cliquez pour agrandir...
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...✌️
 
Vote positif 0 Vote négatif
Gégé-45550

Gégé-45550

XLDnaute Accro
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
Cliquez pour agrandir...
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.
 
Vote positif 0 Vote négatif
patricktoulon

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
 
Vote positif 0 Vote négatif
patricktoulon

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
Vote positif 0 Vote négatif

Discussions similaires

B
  • Résolu(e)
XL 2016 Concours/ Adapter ou modifier le fonctionnement de deux boutons dans un use forme
Réponses
10
Affichages
200
Oneida
Oneida
F
  • Question
XL 2021 Boutons Excel vers emplacement de stock
Réponses
6
Affichages
325
chris
chris
R
  • Question
Microsoft 365 Macro masquer/Afficher des lignes avec un bouton
Réponses
8
Affichages
191
Staple1600
Staple1600
halecs93
  • Résolu(e)
XL 2016 Afficher Onglet par VBA
Réponses
10
Affichages
284
Lolote83
L
A
  • Résolu(e)
Microsoft 365 Personnalisation du calendrier de Patrick Toulon
Réponses
6
Affichages
302
patricktoulon
patricktoulon
BlaackMamba
  • Question
Microsoft 365 ajout de feuille excel
Réponses
2
Affichages
277
BlaackMamba
BlaackMamba
M
  • Résolu(e)
Power Query Convertir un fichier PdF en Excel et restitution d'un état de synthèse
Réponses
10
Affichages
453
Merlin258413
M
T
  • Résolu(e)
XL 2016 problème d'apparition automatique non voulue d'une série de date dans une colonne de tableau
Réponses
3
Affichages
255
therse
T
M
  • Question
XL 2016 Bouton avec 2 macro (Position 1 - Position initiale)
Réponses
12
Affichages
359
patricktoulon
patricktoulon
B
  • Question
XL 2019 numerotation et nommination automatique facture
Réponses
4
Affichages
396
bauerjackob
B

Membres actuellement en ligne

5 membres et 46 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 206
Messages
2 086 219
Membres
103 158
dernier inscrit
laufin