Amélioration code VBA + conseils Le sujet est résolu

Y compris Power BI, Power Query et toute autre question en lien avec Excel
c
cheepow
Jeune membre
Jeune membre
Messages : 19
Appréciation reçue : 1
Inscrit le : 25 novembre 2019
Version d'Excel : 2016

Message par cheepow » 25 novembre 2019, 17:50

Bonjour à tous,

Je vais essayer d'être le plus clair possible.

Dans le fichier excel ci joint se trouver sur la première feuille 3 boutons (Nouvelle License (1), Nouveau adhérent (2), Paiement effectué (3)), ainsi qu'un tableau avec la liste de mes adhérents.
Sur la feuille 2 nous avons un autre tableau avec la demande des licences en cours.

Voici le détail de chaque fonction :

Fonction 1 :

Lorsque je veux entrer un nouveau adhérent, je clique sur le bouton (2), les informations s'enregistrent dans le tableau feuille 1. Cette fonction marche, or lorsque les informations sont entrées, j'aimerais qu'il me quadrille toutes la ligne, or il me quadrille que les nouvelles informations entrées (1er problème)

Fonction 2 :

Une macro tourne en fond (ThisWorkBook) afin de vérifier que si la date de renouvellement de la cotisation est inférieur à la date d'aujourd'hui, la ligne de l'adhérent en retard de paiement doit se remplir en rouge. Cette fonction fonctionne aussi mais uniquement pour 20 adhérents max pour le moment car je le fais cellule par cellule et je vous avoue que si quelqu'un a une proposition pour rendre cette partie de code plus simple et plus ajustable je suis preneur (Problème 2)

Fonction 3 :

Une fois le paiement en retard, réglé, je clique sur le bouton (3), la ligne repasse en blanc et la colonne date de dernier paiement se met à la date d'aujourd'hui.Fonctionne nickel :)


Fonction 4 :

Si un adhérent a besoin d'une licence, je clique sur le bouton (1), un userform apparait et me demande pour quel adhérent. Je le sélectionne il regarde dans la feuille 2 si une demande de licence existe déjà si oui, affiche d'un message d'avertissement. Si non, il copie les informations de la feuille 1 vers la feuille 2 sur cet utilisateur et la c'est le drame rien ne fonctionne et je vous avoue avoir essayé pleins de choses. (Problème 3)


Si des personnes arrivent à me débarrasser de ces lacunes ce serait formidable ou même de m'orienter vers des améliorations de design, code ou autre je suis à l'écoute bien entendu.


Je suis conscient que certains vont rire en voyant les différents codes mais je ne suis pas de ce métier :)


J'espère avoir était clair dans mes explications.
Classeur1.xlsm
(616.02 Kio) Téléchargé 6 fois
A
AlgoPlus
Membre dévoué
Membre dévoué
Messages : 674
Appréciations reçues : 56
Inscrit le : 27 février 2019
Version d'Excel : 2007

Message par AlgoPlus » 25 novembre 2019, 18:10

Bonjour,

Fonction 1 :

Dans Private Sub CommandButton1_Click() de l'Userform1, remplacer
Set Rng = Worksheets(1).Range("A2:G65535")
For Each Cel In Rng.Cells
If Cel <> "" Then
Cel.Borders(xlEdgeLeft).LineStyle = xlContinuous
Cel.Borders(xlEdgeRight).LineStyle = xlContinuous
Cel.Borders(xlEdgeBottom).LineStyle = xlContinuous
Cel.Borders(xlEdgeTop).LineStyle = xlContinuous
End If
Next Cel
par
Worksheets(1).Range("A" & Lig & ":G" & Lig).Borders.LineStyle = xlContinuous
A+
1 membre du forum aime ce message.
Avatar du membre
curulis57
Passionné d'Excel
Passionné d'Excel
Messages : 3'733
Appréciations reçues : 220
Inscrit le : 4 janvier 2016
Version d'Excel : 2016 FR / 2019 FR

Message par curulis57 » 25 novembre 2019, 21:18

Salut Cheepow,
Salut AlgoPlus,

premier jet, ton fichier étant un peu chamboulé! :lole:
Tous ces USF pour si peu : simplicité, simplicité ! ;;)
Mode d'emploi
- je t'ai laissé ta USF "Nouvel adhérent" en réglant les TABINDEX afin de passer plus logiquement de TextBox en TextBox et en ajoutant un bouton "Quitter".
Inscription de la date d'inscription en [G] et tri de la BDD Adhérents.
Petit détail à mettre au point : le n° d'adhérent est, j'imagine, définitif, même si l'adhérent quitte le groupe ?
- ce "détail" et l'opération d'élimination d'un adhérent ne sont pas encore réalisés.
- pour encoder une demande de licence, un double-clic sur une des 3 cellules-identification en [A-B-C] lance la recherche.
MsgBox si déjà encodée, autre MsgBox pour confirmer la demande et tri de la liste ;
- pour l'alerte retard de cotisation, une simple MFC en [G] colore de rouge la date ;
- pour valider le paiement, double-clic en [F] sur la cellule correspondante inscrit la date du jour et ajoute 1 an à la date figurant en [G].
If Not Intersect(Target, Range("F:F")) Is Nothing Then
    iRow = Target.Row
    If Target <> "" And iRow > 2 Then
        Range("F" & iRow).Value = Date
        Range("G" & iRow).Value = DateAdd("yyyy", 1, CDate(Range("G" & iRow).Value))
    End If
End If
A tester, comme on dit...

8-)
A+
Cheepow.xlsm
(610.93 Kio) Téléchargé 4 fois
1 membre du forum aime ce message.
c
cheepow
Jeune membre
Jeune membre
Messages : 19
Appréciation reçue : 1
Inscrit le : 25 novembre 2019
Version d'Excel : 2016

Message par cheepow » 26 novembre 2019, 09:52

Bonjour Algoplus,

Merci pour ta réponse et en effet beaucoup plus court et enfin 100% fonctionnel :)
c
cheepow
Jeune membre
Jeune membre
Messages : 19
Appréciation reçue : 1
Inscrit le : 25 novembre 2019
Version d'Excel : 2016

Message par cheepow » 26 novembre 2019, 09:56

Bonjour Curulis67,

Tu es un génie. lol

En effet je ne savais pas qu'il était possible de le réaliser de cette manière. Pour le numéro d'adhérent, oui en effet le numéro est unique et lorsque la personne s'en va ce numéro disparait :)

Je vais voir pour ajouter deux trois petite chose, il faut que je réalise un onglet vaccination aussi, mais je vais partir sur ta base qui est vraiment plus simple et très bien réalisée.
c
cheepow
Jeune membre
Jeune membre
Messages : 19
Appréciation reçue : 1
Inscrit le : 25 novembre 2019
Version d'Excel : 2016

Message par cheepow » 28 novembre 2019, 16:08

Bonjour Curulis67,

J'ai montré le fichier à ma femme car c'est elle qui va l'utiliser. Or elle préfère que se soit la ligne entière qui se met en rouge lorsqu'un adhérent est en retard de paiement pour être sur de le voir.
J'ai essayé de le changer en faisant une MEFC en sélectionnant la ligne entière mais ça me le fait que sur une seule cellule, je ne sais pas pourquoi.
1 membre du forum aime ce message.
Avatar du membre
curulis57
Passionné d'Excel
Passionné d'Excel
Messages : 3'733
Appréciations reçues : 220
Inscrit le : 4 janvier 2016
Version d'Excel : 2016 FR / 2019 FR

Message par curulis57 » 28 novembre 2019, 17:42

Salut Cheepow,

mes respects à Madame!
J'avais préparé une suite au fichier précédent puis, de coupables distractions... :oops:

- la MFC est actualisée selon les voeux de madame ;
- j'ai fixé les volets en [A3] pour garder les lignes d'en-tête toujours visibles ;
- j'ai supprimé des... bordures bizarrement placées dans les profondeurs de la feuille principale...
- chose importante pour faciliter le futur travail de recherche d'un adhérent : dans chaque feuille (Licences, Vaccinations,...), il FAUT placer en [A] le n° d'adhérent.
Imagine plusieurs membres ayant le même nom : leur n° d'adhérent unique évite bien des soucis au code !
- le problème des n° d'adhérent unique, même après départ, est ici résolu : j'ai déplacé le bouton "NEW" sur [B1-B2] ce qui me permet de "cacher" en [B2] le dernier n° enregistré.
Ainsi, même si les quelques derniers adhérents venaient à faire défection, un nouvel arrivant recevrait le n° suivant.
- un clic-DROIT sur un NOM ou prénom te permet d'éliminer facilement un adhérent, après confirmation, avec, en prime, une recherche-élimination de cet adhérent dans les autres feuilles.
A améliorer car je ne connais évidemment pas ces feuilles ni leur structure.
Tu peux voir ci-dessous la recherche FIND avec le n° d'adhérent : plus simple !
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
'
Dim iRow%, iRep%, iNum%
'
If Not Intersect(Target, Range("B:C")) Is Nothing Then
    Cancel = True
    iRow = Target.Row
    If Target <> "" And iRow > 2 Then
        iRep = MsgBox("Elimination de " & Cells(iRow, 2) & " " & Cells(iRow, 3) & " ?", vbQuestion + vbYesNo, "Sortie d'un adhérent")
        If iRep = 6 Then
            On Error Resume Next
            With Worksheets("Licences")
                iNum = Range("A" & iRow).Value
                Set rCel = .Range("A:A").Find(what:=iNum, lookat:=xlWhole, LookIn:=xlValues, searchdirection:=xlNext)
                If Not rCel Is Nothing Then .Rows(rCel.Row).Delete shift:=xlUp
            End With
            On Error GoTo 0
            Rows(iRow).Delete shift:=xlUp
            Columns("B:G").AutoFit
            ActiveSheet.Shapes("cmdNEW").Width = Columns(2).ColumnWidth * 5.33
        End If
    End If
End If
'
End Sub
- enfin, un embryon de système de recherche d'adhérent, toujours selon leur n°.
En [A1], cellule orange, si tu tapes :
* un simple n°, la ligne de l'adhérent est grisée dans la feuille principale ;
* un n° puis la 1ère lettre de la feuille (autre que la feuille principale) recherche cet adhérent sur cette feuille.
Ex : 5/L (sans espaces) = adhérent n° 5 en feuille 'Licences' ;
Mais, vraiment à améliorer suivant indications ou... à éliminer si inutile ou mal foutu pour toi... :lol:

A tester

8-)
A+
Cheepow.xlsm
(619.53 Kio) Téléchargé 3 fois
1 membre du forum aime ce message.
c
cheepow
Jeune membre
Jeune membre
Messages : 19
Appréciation reçue : 1
Inscrit le : 25 novembre 2019
Version d'Excel : 2016

Message par cheepow » 6 janvier 2020, 16:04

Merci Curulis57 tu es un génie c'est parfait. Désolé pour le temps de réponse mais j'ai pas pu revenir dessus avant cette fin d'année était chargée. Bonne année et meilleurs voeux.
Sujet résolu
Avatar du membre
curulis57
Passionné d'Excel
Passionné d'Excel
Messages : 3'733
Appréciations reçues : 220
Inscrit le : 4 janvier 2016
Version d'Excel : 2016 FR / 2019 FR

Message par curulis57 » 6 janvier 2020, 17:12

Salut Cheepow,

cool ! Que demande le peuple ?
Si tu as d'autres modifs' ou corrections ou autres, tu connais l'adresse... ;;)

Bien le bonjour à Madame !
Meilleurs voeux ! :)

8-)
A+
1 membre du forum aime ce message.
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message