aide creation petit programme...

JCGL

XLDnaute Barbatruc
Re : aide creation petit programme...

Bonjour à tous,

J'ai répondu à ton MP...

J'ai un peu arrangé ton fichier mais il pèse 280 Ko zippé...

A tout de suite pour ton fichier avec données confidentielles en courriel

A++
A+ à tous
 

JCGL

XLDnaute Barbatruc
Re : aide creation petit programme...

Bonjour à tous,

J'ai renvoyé le fichier à notre ami.

Modification :

* Suppression des =Pointage!$A7 et suivant en feuille Salaire, mise en "dur" des Identifiants à partir de la feuille Data

*Ajout d'un petit code pour mettre 1, en $J$6:$AN$459 de la feuille Salaire, par défaut lors de l'Archivage et donc sur le nouveau fichier créé

*Pas de modification du code d'Hasco qui continue à bien tourner malgré les formules rajoutées en $J$6:$AN$459 de la feuille Salaire mais qui se trouvent écrasées par son code

A+ à tous

Et surement à bientôt, connaissant notre ami Ali arf arf :p
 

jichiali

XLDnaute Nouveau
Re : aide creation petit programme...

Bonjour à tous,

J'ai renvoyé le fichier à notre ami.

Modification :

* Suppression des =Pointage!$A7 et suivant en feuille Salaire, mise en "dur" des Identifiants à partir de la feuille Data

*Ajout d'un petit code pour mettre 1, en $J$6:$AN$459 de la feuille Salaire, par défaut lors de l'Archivage et donc sur le nouveau fichier créé

*Pas de modification du code d'Hasco qui continue à bien tourner malgré les formules rajoutées en $J$6:$AN$459 de la feuille Salaire mais qui se trouvent écrasées par son code

A+ à tous

Et surement à bientôt, connaissant notre ami Ali arf arf :p
finalement t'as bien appris à me connaitre...!!! :D:D:D
 
G

Guest

Guest
Re : aide creation petit programme...

Bonjour JiChiali,
Salut JC,

Voici une proposition pour que tous les lignes de pointage (colonne F) se mette à 1 lorsque l'on change le jour dans 'Pointage'!B2

Comme la mise à jour est également faite sur salaire (Si les références idoines existent dans la feuille) cela mets 3 à 4 secondes pour 480 Lignes.

Ne sachant pas où t'envoyer le fichier xls (trop volumineux et données confidentielles) je mets ci-dessous le texte à remplacer pour le code de la feuille Pointage.

Code:
Option Explicit
Dim bCondition As Boolean
 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not bCondition And Target.Cells.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("Pointage").Columns(6)) Is Nothing Then
        Dim NumColSalaire As Long
        Dim Ref As Variant
        Dim i As Long
        Dim c As Range
        For i = 1 To Target.Rows.Count
            Ref = Cells(Target.Rows(i).Row, 1)
            If Ref = 0 Then Exit Sub
            On Error Resume Next
            Application.EnableEvents = False
            With Sheets("Salaire")
                Set c = .Range("D6", Sheets("Salaire").Range("D6").End(xlDown)).Find(What:=Ref, LookIn:=xlValues, lookat:=xlWhole)
                If Not c Is Nothing Then
                    NumColSalaire = .Range("J3").Column + Day(Range("DatePointage")) - 1
                    .Cells(c.Row, NumColSalaire) = Target.Cells(1, 1)
                Else
                    .Cells(.Row, NumColSalaire) = 1
                End If
            End With
            Application.EnableEvents = True
            On Error GoTo 0
        Next i
    ElseIf Not Intersect(Target, Range("DatePointage")) Is Nothing Then
        Dim DerLigne As Long
        DerLigne = Range("A" & Rows.Count).End(xlUp).Row
        Range("B2") = "Mise à jour en cours...Patientez..."
        Application.Calculation = xlCalculationManual
        bCondition = True
        If DerLigne > 6 Then Range("F7:F" & DerLigne).Value = 1
        bCondition = False
        Application.Calculation = xlCalculationAutomatic
        Range("B2") = ""
    End If
End Sub
Bonne soirée à vous toutes et tous.
 

jichiali

XLDnaute Nouveau
Re : aide creation petit programme...

Salut Hasco!!!

Je te remercie infiniment pour ton aide...

je fais ca de suite..je te tiens au courant au plus vite.. ;););)

A très vite!!!

Al:D:D
 

jichiali

XLDnaute Nouveau
Re : aide creation petit programme...

Petit rappel:
J'ai demandé à Hasco de m'aider a faire l'archivage de mon tableau "pointage"...

Hasco dit: "A quoi sert d'archiver "Pointage" qui ne reflète qu'un "jour" alors que "Salaire" te prends le mois entier...
Sur ce coup là, je te comprends de moins en moins...
Mon très cher Ali, reste "logique" "


Reponse: En fait je souhaite archiver mes "pointages", pour me permettre d'effectuer des verifications sur des dates anterieures...
A la limite, en comprenant ce que tu veux dire, je te demanderai de m'aider à archiver les deux tableaux... :eek::eek:

Qu'est ce que t'en pense..?

Merci!!!
 

jichiali

XLDnaute Nouveau
Re : aide creation petit programme...

Bonjour JiChiali,
Salut JC,

Voici une proposition pour que tous les lignes de pointage (colonne F) se mette à 1 lorsque l'on change le jour dans 'Pointage'!B2

Comme la mise à jour est également faite sur salaire (Si les références idoines existent dans la feuille) cela mets 3 à 4 secondes pour 480 Lignes.

Ne sachant pas où t'envoyer le fichier xls (trop volumineux et données confidentielles) je mets ci-dessous le texte à remplacer pour le code de la feuille Pointage.

Code:
Option Explicit
Dim bCondition As Boolean
 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not bCondition And Target.Cells.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("Pointage").Columns(6)) Is Nothing Then
        Dim NumColSalaire As Long
        Dim Ref As Variant
        Dim i As Long
        Dim c As Range
        For i = 1 To Target.Rows.Count
            Ref = Cells(Target.Rows(i).Row, 1)
            If Ref = 0 Then Exit Sub
            On Error Resume Next
            Application.EnableEvents = False
            With Sheets("Salaire")
                Set c = .Range("D6", Sheets("Salaire").Range("D6").End(xlDown)).Find(What:=Ref, LookIn:=xlValues, lookat:=xlWhole)
                If Not c Is Nothing Then
                    NumColSalaire = .Range("J3").Column + Day(Range("DatePointage")) - 1
                    .Cells(c.Row, NumColSalaire) = Target.Cells(1, 1)
                Else
                    .Cells(.Row, NumColSalaire) = 1
                End If
            End With
            Application.EnableEvents = True
            On Error GoTo 0
        Next i
    ElseIf Not Intersect(Target, Range("DatePointage")) Is Nothing Then
        Dim DerLigne As Long
        DerLigne = Range("A" & Rows.Count).End(xlUp).Row
        Range("B2") = "Mise à jour en cours...Patientez..."
        Application.Calculation = xlCalculationManual
        bCondition = True
        If DerLigne > 6 Then Range("F7:F" & DerLigne).Value = 1
        bCondition = False
        Application.Calculation = xlCalculationAutomatic
        Range("B2") = ""
    End If
End Sub
Bonne soirée à vous toutes et tous.


Hasco Bonjour!!! (ou plutot devrais je dire Monsieur le pro d'Excel!!!:D:D)

EXCELLENT!!! trop cool ton code... j'esssai de le lire...mais comprend rieng... lol
cependant il fonctionne a merveille!!! et un grand merci!!!!

Je suis entrain d'essayer cette dernière version, que Hasco et l'autre Génie (Mister JC!!!! lol) m'ont aider à faire...

Je vous fait signe au plus vite... pour vous donner les dernieres informations la dessus...


MERCI ENCORE UNE FOIS!!!!!!! :D:D:D:D:D:D:D

Al
 
G

Guest

Guest
Re : aide creation petit programme...

Chers Ali, et JC,

1 - J'ai tenté une optimisation de la procédure d'archivage de la feuille 'Salaire'. Cette nouvelle version paraît plus rapide(en tous cas chez moi)

Ali, teste les deux et garde celle que tu voudras.

Nouvelle Version:
Code:
Sub ArchivageFeuilleSalaire()
    Dim Wkb As Workbook
    Dim LaDate As String
    
    On Error GoTo FinArchivage
    Application.ScreenUpdating = False
    
    'Création du nouveau classeur
    Set Wkb = Workbooks.Add
    
    ' Avec ce classeur
    With ThisWorkbook
        LaDate = Format(.Sheets("Pointage").Range("B1").Value, "yyyy_mm")
        .Sheets("Salaire").UsedRange.Copy
    End With
    
    'Avec le nouveau classeur
    With Wkb
        With .Sheets(1) ' avec sa feuille 1
            With .Range("A1")
                .PasteSpecial Paste:=xlPasteValues
                .PasteSpecial Paste:=xlPasteFormats
            End With
            .Name = "Salaire"
            .Range("A3:AQ3").EntireColumn.AutoFit
        End With
        .SaveAs Filename:=ThisWorkbook.Path & "\Gestion_Ali_" & LaDate & ".xls"
        .Close
    End With
    
    'Mettre les valeurs de la feuille 'Salaire' à blanc
    Sheets("Salaire").Range("J6:AN459").ClearContents
    
FinArchivage:
    Application.ScreenUpdating = True
    Application.CutCopyMode = False
End Sub
Ps: Provenace Bretagne(finistère Nord), habitation Vendée depuis 10 ans après 9 ans passés dans le département de notre ami JC.

bons Tests Ali;)

bonne soiréeJC:)

A demain tous.
 

JCGL

XLDnaute Barbatruc
Re : aide creation petit programme...

Bonjour à tous,
Salut Hasco :),
Salut Ali :),

Ali : il n'y a pas photo prend le code de notre ami...;)

Nous déposerons un fichier "allégé" et anonymisé quand Ali sera satisfait du résultat (arf arf, comme il en veut toujours plus... :p)

PS : Nous conversons en MP avec Ali, qui est en Guinée, et il nous demandait où nous habitions. Ceci pour expliquer le petit mot d'Hasco...

A++
A+ à tous
 

jichiali

XLDnaute Nouveau
Re : aide creation petit programme...

Hasco bonjour,
JC bonjour,
Bonjour à tous,

je m'excuse de cette si longue absence.... quelques petits problemes internes au boulot... :p

J'ai reussi a rattraper mon temps perdu grace à ce jolie bébé crée par HASCO et JC!!!

Alors...les résultats... :p:p
Hasco...je n'arrive toujours pas à valider les "1" automatiquement dans "pointage"... ou plutot..ca pointe "1" dans "pointage" mais ce n'est pas reporté dans "salaire"...je t'envoi le dossier en MP pour essai de toi meme...lol

Et concernant le code d'archivage:
je n'ai pas reussi à le faire fonctionner...pourtant j'ai bien coller ce que tu m'as envoyé... :confused::confused::confused:

Sinon a part ca!!! j'avoue que ce logiciel m'a vraiment permit de gagner enormement de temps sur le travail...j'ai reussi a rattrapé tout le retard que j'avais... :p:p:p et surtout de m'occuper un peu du reste que j'avai que j'avais à faire...

Hasco...JC...j'espere que tu ne m'en voudrez pas si je vous demandais une fois de plus de m'aider à améliorer ce programme...:eek::eek::eek:
(amélioration que je souhaite...:
- pointage automatique des que j'active la date...ce que Hasco m'a fait...mais ca ne me pointe que quelques personnes...je t'envoi le fichier pr verif..
- archivage de "pointage" ET "salaire"

je vous envoi mon fichier en mp...

Merci beaucoup!!!!
 

JCGL

XLDnaute Barbatruc
Re : aide creation petit programme...

Bonjour à tous,
Salut Ali,

Le code fonctionne parfaitement dans la feuille Pointage...
Il te faut valider les 1 pour qu'ils se reportent en feuille "Salaire" et "Facture"

Pour l'archivage remplace dans le ModArchivage :
Code:
 Sheets(Array("Pointage", "Facture", "Data", "Données")).Delete
par
Code:
 Sheets(Array("Facture", "Data", "Données")).Delete
A++
A+ à tous
 

jichiali

XLDnaute Nouveau
Re : aide creation petit programme...

Salut JC,
Bonjour à tous!!!

OK je vais essayer ce que tu m'as envoyé,
je te tieng au courant... :)

et concernant la validation des pointages "1"... Hasco m'avait fait un code pour que tout se valide automatique dès que je mets la date (B1)....
ca fonctionne...mais en partie uniquement...j'en ai une 40taine qui se valide sur salaire et facture..mais pas plus...

essai la version que je t'ai envoyé en mp... peut etre est ce a cause de l'espace que je mettais entre les lieux... :confused::confused::confused:

Je reviens sur le forum au plus vite pour vous dire ce qu'il en est....

A t'aleur... boulot m'appel!!!:(:(:(
 

JCGL

XLDnaute Barbatruc
Re : aide creation petit programme...

Re,

Ce sont surtout les vides en colonne A de la feuille "Pointage" qui posent problème....

Tu remarqueras ceci dans :
Code:
Dim DerLigne As Long
        DerLigne = Range("A" & Rows.Count).End(xlUp).Row
Les 1 sont bien en colonne F mais "invisible" grâce à un MeFC...

A++
 

jichiali

XLDnaute Nouveau
Re : aide creation petit programme...

Re,

Ce sont surtout les vides en colonne A de la feuille "Pointage" qui posent problème....

Tu remarqueras ceci dans :
Code:
Dim DerLigne As Long
        DerLigne = Range("A" & Rows.Count).End(xlUp).Row
Les 1 sont bien en colonne F mais "invisible" grâce à un MeFC...

A++
J'ai essayé en ne mettant aucun espace...effectivement ca fonctionne parfaitement!!! :D:D:D MERCI LE GENIE!!!!

MERCI JC HASCO ET TOUS!!!!

Je vous tiens au courant concernant l'autre code...celui de l'archivage...

A d'taleur!!! :p:p:p
 

jichiali

XLDnaute Nouveau
Re : aide creation petit programme...

Bonjour JC!
Bonjour Hasco!
Bonjour à tous!!

Désolé de cette nouvelles absence si longue... quoique...je suis sure que ca a du faire plaisir a quelques personnes... ( :D)
Alors concernant le petit bébé...
hum...
j'ai eu le temps de l'essayer ces deux derniers jours...et franchement..RIEN A DIRE!!!
HASCO et JC!!! vous etes des pros!!! je fais mes pointages très rapidement maintenant...plus que les num d'identifiant à entrer, ensuite je valide avec la date, et grace au code de Hasco, tout se répercute automatiquement sur salaire et facture!!! GENIAAAAALLLL!!! :D :D :D :D

je vous envoi des demain le fichier excel vierge afin de l'avoir sur le net..

Hasco...une derniere petite chose a te demander stp...
concernant l'archivage...
j'arrive a archiver...mais ya des moment j'ai une partie du code qui fait planter l'opération...
J'ai essayer de comprendre comment se passait toute cette programmation..et j'ai compris quelques truc...
j'ai donc essayé de changer quelques truc...genre l'archivage qui se fait sous le nom "Archivage_yyyy_mm_dd" au lieu de "Gestion_Ali_yyyy_mm"...
a un moment ca a marché..mais plus mainan...??? comprend pas...
Donc je voulais savoir si tu pouvais m'aider a faire ca par la même occasion...

SINON A PART CA... JE CROIS KON Y EST ENFIN ARRIVE!!!! GRACE AUX GENIES HASCO ET JC!!!

TRES SINCERES REMERCIEMENT A TOUS LES DEUX ET A TOUS!!!
A TRES VITE!!!!


je t'envoi le code:

Sub Archivage()
Application.ScreenUpdating = False
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\Gestion_Ali_" & Format(Range("B1").Value, "yyyy_mm_dd") & ".xls"
Workbooks.Open Filename:=ThisWorkbook.Path & "\Gestion_Ali.xls"
ActiveWorkbook.Save
Windows("Gestion_Ali" & Format(Range("B1").Value, "yyyy_mm_dd") & ".xls").Activate
With Sheets("Salaire").Range("A1:AZ500")
.Copy
.PasteSpecial Paste:=xlPasteValues
.PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
Application.DisplayAlerts = False
End With
With Sheets("Pointage").Range("A1:AZ500")
.Copy
.PasteSpecial Paste:=xlPasteValues
.PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
Application.DisplayAlerts = False
Sheets(Array("Facture", "Data", "Données")).Delete
Range("A1").Select
Application.DisplayAlerts = True
End With
ActiveWorkbook.Save
ActiveWindow.Close

Application.ScreenUpdating = True
Workbooks.Open Filename:=ThisWorkbook.Path & "\Gestion_Ali.xls"
Sheets("Salaire").Range("J6:AN459").ClearContents
Range("B1").Select
End Sub

Sub Nettoyage()
Sheets("Salaire").Range("J6:AN459").ClearContents
End Sub
 
G

Guest

Guest
Re : aide creation petit programme...

Bonsoir Ali:),
Bonsoir JC:) ( je ne sais pas si t'es toujours là)

Ali,

Cette procédure d'archivage n'est pas la dernière version sur laquelle nous nous étions mis d'accord.

Voici la dernière version qui fonctionne:

Code:
Sub ArchivageFeuilleSalaire()
    Dim Wkb As Workbook
    Dim LaDate As String
    
    On Error GoTo FinArchivage
    Application.ScreenUpdating = False
    
    'Création du nouveau classeur
    Set Wkb = Workbooks.Add
    
    ' Avec ce classeur
    With ThisWorkbook
        LaDate = Format(.Sheets("Pointage").Range("B1").Value, "yyyy_mm")
        .Sheets("Salaire").UsedRange.Copy
    End With
    
    'Avec le nouveau classeur
    With Wkb
        With .Sheets(1) ' avec sa feuille 1
            With .Range("A1")
                .PasteSpecial Paste:=xlPasteValues
                .PasteSpecial Paste:=xlPasteFormats
            End With
            .Name = "Salaire"
            .Range("A3:AQ3").EntireColumn.AutoFit
        End With
        .SaveAs Filename:=ThisWorkbook.Path & "\Gestion_Ali_" & LaDate & ".xls"
        .Close
    End With
    
    'Mettre les valeurs de la feuille 'Salaire' à blanc
    Sheets("Salaire").Range("J6:AN459").ClearContents
    
FinArchivage:
    Application.ScreenUpdating = True
    Application.CutCopyMode = False
End Sub
cordialement Ali
;)JC
 

JCGL

XLDnaute Barbatruc
Re : aide creation petit programme...

Re,
Salut Hasco :),
Salut Ali,

Tout comme mon ami Hasco nous étions d'accord pour prendre la dernière version, qu'elle soit déposée ou en MP....

Ali : Charge à toi de déposer un fichier anonymisé et zippé quand tu penseras que le fil est résolu (ARF ARF Hasco, je pense que ce n'est pas fini... C'est pour rire Ali :))

PS : Hasco, je reste connecté : j'ai un souci avec un membre "important"... Enfin un souci pour l'image d'XLD, la mienne peut m'en chaut)

A+++ mes amis Hasco et Ali
A+ à tous
 
G

Guest

Guest
Re : aide creation petit programme...

Re Ali,
re jc,

Après avoir examiné ta procédure d'archivage (celle de ton dernier message) je me suis apperçu que ton problème vient de :

Code:
Format(Range("B1").Value, "yyyy_mm_dd")
qu' il faut remplacer par

Code:
Format([COLOR=red]Sheets("Pointage").[/COLOR]Range("B1").Value, "yyyy_mm_dd")
Range("B1").Value, tout seul renvoie la valeur de B1 de la feuille active.
donc si la macro était appelée alors que la feuille 'Pointage' n'était pas la feuille active cela ne pouvait fonctionner correctement.

D'une façon général, lorsque Excel t'envoie un message d'erreur, avec la proposition de Débogage, accepte le débogage et dans l'editeur de macro affiche la 'fenêtre d'exécution' (CTRL+G) pour tester les variables ou la fenêtre 'Variables Locales'. Au moins pour localiser correctement l'erreur.

A++
A++
A++ tout le monde
 

Discussions similaires


Haut Bas