Modification de code macro--- aide

[almas]

Bonjour le forum

j 'ai fait un classeur de gestion du personnel très complexe et on c 'est aperçus qu ' une de mes macros ne donnais pas exactement le résultat attendu.

la macro permet de parcourir tous les onglets "nom du perssonnel" et d 'afficher des données lies au absences du mois choisis
j 'ai donc une date de début et une date de fin mais j 'ai extrait le mois que sur la 1er date

donc pour les absences à cheval sur 2 mois mon extraction n 'est pas complète
ex: si je demande mars je n 'ai pas les donnée qui ont une date de début en février

j 'ai donc extrait le mois de la date de fin également et fait que la macro recherche sur les 2

ça marche bien sauf que ça me double toute les données

je sais plus trop comment faire ....si quelqu un a la solution le l 'en remercie d avance

code:
Public flag As Boolean
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$E$3" Then Exit Sub mois choisis
Application.EnableEvents = False
tx = [E3]
lig = 8
[A8:J400].ClearContents
'Stop
Set plage = Sheets("base de donnée").Range("T2:T90")
For Each cel In plage
flag = 0
k = cel.Value
If k = "" Then Application.EnableEvents = True: Exit Sub
'Stop
For Each sh In ActiveWorkbook.Sheets
If sh.Name = k Then a = sh.Name: flag = 1: Exit For
Next sh
If flag = 0 Then MsgBox ("La feuille " & k & " n'existe pas, Faire les modif nécessaires"): Application.EnableEvents = True: Exit Sub

With Sheets(k).[L17:M96] colones L et M = mois de debut de date et fin de date
Set a = .Find(tx, LookIn:=xlValues)
If Not a Is Nothing Then
firstAddress = a.Address
Do
Cells(lig, 1) = Sheets(k).Cells(a.Row, 1)
Cells(lig, 2) = Sheets(k).Cells(a.Row, 2)
Cells(lig, 3) = Sheets(k).Cells(a.Row, 3)
Cells(lig, 4) = Sheets(k).Cells(a.Row, 4)
Cells(lig, 5) = Sheets(k).Cells(a.Row, 5)
Cells(lig, 6) = Sheets(k).Cells(a.Row, 6)
Cells(lig, 7) = Sheets(k).Cells(a.Row, 7)
Cells(lig, 8) = Sheets(k).Cells(a.Row, 8)
Cells(lig, 9) = Sheets(k).Cells(a.Row, 9)
lig = lig + 1
Set a = .FindNext(a)
Loop While Not a Is Nothing And a.Address <> firstAddress
End If
End With
'End If
Next
Application.EnableEvents = True
End Sub

 

[almas]

Re : Modification de code macro--- aide

Bonjour le forum

je vois que personne n 'a de solution pour mon code
nouvelle approche : comment je pourrai je faire pour identifier les lignes qui ont au moins une date du mois choisis et ensuite me servir de cette identification pour l extraction avec l 'exécution de la macro sur cette colonne?
Bonne journée

 

[Lone-wolf]

Re : Modification de code macro--- aide

Bonjour almas,

loin de moi à dire que j'ai trouvé la solution. C'est juste une proposition.

Supprime les Application.EnableEvents superflus. Ceux-ci doivent se trouver, en début et fin de code seulement. Ensuite placer "NEXT" en dessus de With Sheets(k).[L17:M96]. Et fait un test avec ceci sans utiliser Loop While.

'Private Sub Worksheet_Change(ByVal Target As Range)
'Dim a, tx etc.
'Application.EnableEvents = False
'LE CODE
'
'
'
'Application.EnableEvents = True
'End sub

'--------------------------------------------------------

Set a = Sheets(k).Columns("L").Find(What:=tx)
If Not a Is Nothing Then
Cells(lig, 1) = Sheets(k).Cells(a.Row, 1)
Cells(lig, 2) = Sheets(k).Cells(a.Row, 2)
Cells(lig, 3) = Sheets(k).Cells(a.Row, 3)
Cells(lig, 4) = Sheets(k).Cells(a.Row, 4)
Cells(lig, 5) = Sheets(k).Cells(a.Row, 5)
Cells(lig, 6) = Sheets(k).Cells(a.Row, 6)
Cells(lig, 7) = Sheets(k).Cells(a.Row, 7)
Cells(lig, 8) = Sheets(k).Cells(a.Row, 8)
Cells(lig, 9) = Sheets(k).Cells(a.Row, 9)
lig = lig + 1
End If

A+

 

[almas]

Re : Modification de code macro--- aide

merci lone-wolf de te pencher sur mon problème
mon niveau de code est malheureusement trop limité pour avoir bien compris ce que tu voulais me faire essayer

j 'ai bien mis le next et changer la ligne mais j 'ai pas compris le loop while ni la Supprime les Application.EnableEvents superflus.. dsl

 

[Lone-wolf]

Re : Modification de code macro--- aide

Bonjour almas

Pourquoi avoir mis 2 fois ??

If k = "" Then Application.EnableEvents= True : Exit Sub
If flag = 0 Then MsgBox ("La feuille " & k & " n'existe pas, Faire les modif nécessaires"): _
Application.EnableEvents = True: Exit Sub

Alors que tu l'a déjà mis ici

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$E$3" Then Exit Sub
Application.EnableEvents = False 'ATTENTION! A inserer après Private sub Worksheet_Change

Et ici

Application.EnableEvents = True
End Sub


Et pour Loop While tu as bien ceci:

Cells(lig, 9) = Sheets(k).Cells(a.Row, 9)
lig = lig + 1
Set a = .FindNext(a)
Loop While Not a Is Nothing And a.Address <> firstAddress
End If
End With

A changer par l'exemple que j'ai donné si besoin.



A+

 

[almas]

Re : Modification de code macro--- aide

c 'est des morceaux de code que l on ma donnée ou que j 'ai trouver sur le forum et que j 'ai adapté à mes besoins

Mes connaissances étant assez limité je ne vois pas les doublons et je ne sais pas les corriger
j 'essais de comprendre mais n 'ayant jamais eu les bonne base je me perd très vite.

j 'avoue ne pas savoir construire le code comme il faut même si j 'en comprend les grandes lignes.( j ai fait plusieurs essais sans succès )

il est dans le fichiers que j 'ai joint, si c 'est pas trop abusés pourrai tu m 'insérer les lignes au bonnes endroit SVP?

 

[Lone-wolf]

Re : Modification de code macro--- aide

Re almas

Fait un copier-coller de ton fichier sur le bureau et renomme-le(on ne sais jamais), et ensuite test comme ceci:

Public flag As Boolean
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cel As Range, tx As Range, plage As Range
Dim lig As Long, k As String, sh As Worksheet, a

Application.EnableEvents = False
If Target.Address <> "$E$3" Then Exit Sub   'mois choisis
Set tx = Range("e3")
lig = 8
Range("a8:j400").ClearContents
flag = 0
Set plage = Sheets("base de donnée").Range("T2:T91")
For Each cel In plage
flag = 1

If k = "" Then: flag = 0: k = cel.Value: _
MsgBox ("La feuille " & k & " n'existe pas, Faire les modif nécessaires"): Exit Sub


For Each sh In ActiveWorkbook.Sheets
If sh.Name = k Then
flag = 1
'With Sheets(k).Range("a2:o96")
'Colonnes L et M = mois de debut de date et fin de date
Set a = Sheets(k).Range("a2:o91").Find(What:=tx)
If Not a Is Nothing Then
Cells(lig, 1) = Sheets(k).Cells(a.Row, 1)
Cells(lig, 2) = Sheets(k).Cells(a.Row, 2)
Cells(lig, 3) = Sheets(k).Cells(a.Row, 3)
Cells(lig, 4) = Sheets(k).Cells(a.Row, 4)
Cells(lig, 5) = Sheets(k).Cells(a.Row, 5)
Cells(lig, 6) = Sheets(k).Cells(a.Row, 6)
Cells(lig, 7) = Sheets(k).Cells(a.Row, 7)
Cells(lig, 8) = Sheets(k).Cells(a.Row, 8)
Cells(lig, 9) = Sheets(k).Cells(a.Row, 9)
End If
lig = lig + 1
End If
Next sh
Next cel
Application.EnableEvents = True
End Sub

Malheureusement plus je ne saurais faire, en souhaitant qu'un expert vienne te donner un coup de pouce.


A+

 

[almas]

Re : Modification de code macro--- aide

merci bc Lone....

bon le code ne lis plus les onglet et me dit de suite qu' il n 'existe pas
j'ai comparer les 2 codes et je vois pas ou ce situe le problème car j 'ai fait quelque tests en changent des bout mais toujours
pareil...je continue de chercher

merci encore

 

[Lone-wolf]

Re : Modification de code macro--- aide

Re almas,

Pour chaque nom que tu as dans la liste déroulante, est-ce qu'une nouvelle feuille doit se créer avec le nom de la personne choisie?

Ensuite, pourquoi aller cercher le nom de la personne en colonne T, alors que tu as les noms complet dans la colonne A de la Base de données? Et où sont inscrites les heures de chaque collaborateur?


A+

 

[almas]

Re : Modification de code macro--- aide

bonjour le forum

Lone , non les feuil sont créé manuellement et pour les noms c 'est que j 'ai un maximum d 'extractions différentes et pour certaine il ne faut pas de blanc dans le nom de l 'onglet d' ou le "_" entre le nom et prénom

pour ce qui est du code j 'ai tester 25 truc mais rien n y fait je trouve pas pourquoi il ne trouve plus les feuil a lire.....

 

[almas]

Re : Modification de code macro--- aide

bonjour le forum

Bon je n 'ai pas réussis à comprendre pourquoi le code de Lorne ne trouve pas mes onglets et du coup je suis coincé

si quelqu un peut m 'aider plizz , ça serai très sympatrique

Public flag As Boolean
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cel As Range, tx As Range, plage As Range
Dim lig As Long, k As String, sh As Worksheet, a

Application.EnableEvents = False
If Target.Address <> "$E$3" Then Exit Sub 'mois choisis
Set tx = Range("e3")
lig = 8
Range("a8:j400").ClearContents
flag = 0
Set plage = Sheets("base de donnée").Range("T2:T91")
For Each cel In plage
flag = 1

If k = "" Then: flag = 0: k = cel.Value: _
MsgBox ("La feuille " & k & " n'existe pas, Faire les modif nécessaires"): Exit Sub


For Each sh In ActiveWorkbook.Sheets
If sh.Name = k Then
flag = 1
'With Sheets(k).Range("a296")
'Colonnes L et M = mois de debut de date et fin de date
Set a = Sheets(k).Range("a291").Find(What:=tx)
If Not a Is Nothing Then
Cells(lig, 1) = Sheets(k).Cells(a.Row, 1)
Cells(lig, 2) = Sheets(k).Cells(a.Row, 2)
Cells(lig, 3) = Sheets(k).Cells(a.Row, 3)
Cells(lig, 4) = Sheets(k).Cells(a.Row, 4)
Cells(lig, 5) = Sheets(k).Cells(a.Row, 5)
Cells(lig, 6) = Sheets(k).Cells(a.Row, 6)
Cells(lig, 7) = Sheets(k).Cells(a.Row, 7)
Cells(lig, 8) = Sheets(k).Cells(a.Row, 8)
Cells(lig, 9) = Sheets(k).Cells(a.Row, 9)
End If
lig = lig + 1
End If
Next sh
Next cel
Application.EnableEvents = True
End Sub

 

[Lone-wolf]

Re : Modification de code macro--- aide

Bonjour almas,

j'ai repris le premier code que tu as édité et enlevé juste les 2 Application.EnableEvents en trop.

Public flag As Boolean
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Address <> "$E$3" Then Exit Sub mois choisis

tx = [E3]
lig = 8
[A8:J400].ClearContents
'Stop
Set plage = Sheets("base de donnée").Range("T2:T90")
For Each cel In plage
flag = 0
k = cel.Value
If k = "" Then: Exit Sub
'Stop
For Each sh In ActiveWorkbook.Sheets
If sh.Name = k Then a = sh.Name: flag = 1: Exit For
Next sh
If flag = 0 Then MsgBox ("La feuille " & k & " n'existe pas, Faire les modif nécessaires"): Exit Sub

With Sheets(k).[L17:M96] colones L et M = mois de debut de date et fin de date
Set a = .Find(tx, LookIn:=xlValues)
If Not a Is Nothing Then
firstAddress = a.Address
Do
Cells(lig, 1) = Sheets(k).Cells(a.Row, 1)
Cells(lig, 2) = Sheets(k).Cells(a.Row, 2)
Cells(lig, 3) = Sheets(k).Cells(a.Row, 3)
Cells(lig, 4) = Sheets(k).Cells(a.Row, 4)
Cells(lig, 5) = Sheets(k).Cells(a.Row, 5)
Cells(lig, 6) = Sheets(k).Cells(a.Row, 6)
Cells(lig, 7) = Sheets(k).Cells(a.Row, 7)
Cells(lig, 8) = Sheets(k).Cells(a.Row, 8)
Cells(lig, 9) = Sheets(k).Cells(a.Row, 9)
lig = lig + 1
Set a = .FindNext(a)
Loop While Not a Is Nothing And a.Address <> firstAddress
End If
End With
'End If
Next
Application.EnableEvents = True
End Sub

Désolé pour l'ancien code que j'avais rectifié, toutes mes excuses.

Voici un classeur démo pour te monter une autre façon de faire, mais il n'est pas encore complètement opérationnel. J'ai un souci avec la feuille "Report Mensuel". Pour voir un peu comment il pratique, vas dans la feuille "Accueil" > sélectionne une personne > clique sur Enregister. Dans la colonne Dates Vers., introduit les dates, attention les autres colonnes contiennent des formules. Doube-clique sur la cellule "Report Mensuel" pour afficher la feuille, faire de même avec le nom de la personne pour afficher sa feuille. Double-clique sur "Accueil" pour y retourner; ici si les feuilles de Monsieur X et Madame Y sont déjà créées, sélectionne Monsieur ou Madame, et double-clique sur la cellule pour afficher la feuille sans toucher à "Enregistrer".

EDIT: + un autre classeur plus proche de ton projet.
L'année à modifier manuellement, une fois le mois rempli, clique sur Horaires. La cellule blanche à gauche affiche les jours ouvrés, celle de droite le total des heures éffectuées. Pour les absences, maladie ou autre; introduit manuellement la couleur selon exemple dans les cellules(Matin ou Après-Midi), si absent toute la journée, introduit manuellement la couleur dans la première cellule puis clique sur le bouton Jours Absences. Le bouton Salaire (optionnel) si tu veux préparer les données pour faire la fiche(à créer).



A+

 

[almas]

Re : Modification de code macro--- aide

bonjour
merci beaucoup Lorn pour ton implication
bon je pense que ce n 'est pas possible que le code ne créé pas de doublon si on lui donne comme consigne 2 données

il va donc falloir que je chercher une autre solution.......

en faite il faudrait que le code compare les 2 colonnes avant ,pour ne pas répéter l opération si a été déjà faite

si la consigne est "MARS" par exemple il faudrait qu' il compare les 2 colonnes et ne prennent qu' une fois la consigne si mars est présent dans les 2 colonne

ça doit être possible en code mais bon la faut que je cherche......
merci encore