Amélioration code VBA + conseils

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.

6classeur1.xlsm (616.02 Ko)

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+

Salut Cheepow,

Salut AlgoPlus,

premier jet, ton fichier étant un peu chamboulé!

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...

A+

4cheepow.xlsm (610.93 Ko)

Bonjour Algoplus,

Merci pour ta réponse et en effet beaucoup plus court et enfin 100% fonctionnel

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.

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.

Salut Cheepow,

mes respects à Madame!

J'avais préparé une suite au fichier précédent puis, de coupables distractions...

  • 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...

A tester

A+

4cheepow.xlsm (619.53 Ko)

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

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 !

A+

Rechercher des sujets similaires à "amelioration code vba conseils"