Microsoft 365 Archivage a partir de Userform

E

eric72

XLDnaute Accro
Bonjour à tous,
J'ai un Userform "UsfEffectif" dans lequel je peux attribuer un planning "fixe" en cliquant sur "obfixe", à ce moment j'ai une combobox qui apparait pour choisir la "Semaine Type" ainsi que la date de début du planning avec un Datepicker, lorsque je valide un nouvel équipier, j'aimerai que les données de la semaine s'archivent dans l'onglet "Archives" à l'aide de la macro Z_Archives (méthode TooFatBoy très efficace et rapide", par contre je dois tester s'il y a déjà des données en ligne 3, sinon mettre en ligne11, etc.... Et c'est là que ça bloque. Quand je teste avec un msgbox il me dit bien que c'est vide mais il n'en tient pas compte...
Si quelqu'un a la solution, ca serait top.
Merci beaucoup une nouvelle fois pour votre aide.
Eric
 

Pièces jointes

  • Planning Type test archives.xlsm
    155.3 KB · Affichages: 15
Solution
E
Bonjour à tous,
J'ai trouvé une solution en ajoutant en colonne "A" un "x" à chaque fois qu'une ligne est remplie.
La méthode n'est pas très académique mais ça a l'air de fonctionner.
Pour ceux que ça peut intéresser!!!
Bonne journée et à bientôt
Trier par date Trier par votes
ChTi160

ChTi160

XLDnaute Barbatruc
Re
Cela peut surement être amélioré !
je ne comprends pas ceux-ci
si c'est fixe la semaine type choisie doit être reportée dans l'onglet "Archives" à partir de la date choisie et cela pour toute les semaines jusqu'à son départ éventuel
Cliquez pour agrandir...
à partir de Quoi tu récupères les éléments de cette Semaine Type ?
car dans la procédure, que tu dis utiliser, je ne vois d'autre référence qu'a la feuille "Archives"
Merci par avance
On pourrait imaginer une procédure de ce Type!
VB: 
With Sheets("Archives")
    Dim ii As Integer, iiii As Byte
    For iiii = 0 To 7
            For iii = 7 To 133 Step 7
               .Cells(iiii + LigSource, iii + ColSource) = .Cells(iiii + LigSource, ColSource).Value
            Next iii
    Next iiii
Mais cela ne fonctionne pas sous cette forme Lol
Bonne fin de Journée
Jean marie
 
Dernière édition:
Vote positif 0 Vote négatif
E

eric72

XLDnaute Accro
ChTi160 à dit:
Re
Cela peut surement être amélioré !
je ne comprends pas ceux-ci

à partir de Quoi tu récupères les éléments de cette Semaine Type ?
car dans la procédure, que tu dis utiliser , je ne vois d'autre référence qu'a la feuille "Archives"
Merci par avance
Bonne fin de Journée
Jean marie
Cliquez pour agrandir...
Dans le Userform "UsfEffectif", je récupère le nom de "TxtNom" et la date de "TxtDateFixe"
ChTi160 à dit:
Re
Cela peut surement être amélioré !
je ne comprends pas ceux-ci

à partir de Quoi tu récupères les éléments de cette Semaine Type ?
car dans la procédure, que tu dis utiliser, je ne vois d'autre référence qu'a la feuille "Archives"
Merci par avance
On pourrait imaginer une procédure de ce Type!
VB: 
With Sheets("Archives")
    Dim ii As Integer, iiii As Byte
    For iiii = 0 To 7
            For iii = 7 To 133 Step 7
               .Cells(iiii + LigSource, iii + ColSource) = .Cells(iiii + LigSource, ColSource).Value
            Next iii
    Next iiii
Mais cela ne fonctionne pas sous cette forme Lol
Bonne fin de Journée
Jean marie
Cliquez pour agrandir...
Pffff c'est bien dommage, ça m'aurait bien arrangé.
Merci Jean-Marie et bonne soirée
 
Vote positif 0 Vote négatif
E

eric72

XLDnaute Accro
ChTi160 à dit:
Ok mais dans ta procédure aucune référence a ça !
Je regarde dès que possible ce que je peux faire.
Jean marie
Cliquez pour agrandir...
Si Jean-Marie, dans la procédure de UsfEffectif, Valider, il y a
If ObFixe = True Then
ArchiverToutFixe ' Ca c'est la procédure qui archive (voir plus bas dans le code) a l'aide de Xlookup
xderligne
DupliquerPlanningFixe

VB: 
Sub ArchiverToutFixe() 'issu de UsfEffectif

Dim RangDuJour As Integer
If UsfEffectif.ObFixe = True Then
Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
            For RangDuJour = 1 To 6
                ArchiverUnPlanningFixe RangDuJour
            Next RangDuJour
Else
End If
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
End Sub
Sub ArchiverUnPlanningFixe(RangDuJour As Integer) 'issu de UsfEffectif
Dim LigCible As Long, ColCible As Long, MaDate As Long

    Application.ScreenUpdating = False
derniereligne = Sheets("Archives").Range("A1").End(xlDown).Row + 1
    LigCible = derniereligne
    MaDate = CDate(UsfEffectif.TxtDateFixe)
    ColCible = Application.Match(MaDate, Sheets("Archives").Range("2:2"), 0) + RangDuJour - 1
    If RangDuJour = 1 Then
        Sheets("Archives").Cells(LigCible, ColCible).Value = UsfEffectif.TxtNom.Value
        Sheets("Archives").Cells(LigCible + 1, ColCible).Value = UsfEffectif.CbSemTypeFixe.Value
        Sheets("Archives").Cells(LigCible + 2, ColCible).Value = Application.WorksheetFunction.XLookup(UsfEffectif.CbSemTypeFixe.Value, Range("TbSemType[Nom Sem Type]"), Range("TbSemType[Absences Lundi AM]"))
        Sheets("Archives").Cells(LigCible + 3, ColCible).Value = Application.WorksheetFunction.XLookup(UsfEffectif.CbSemTypeFixe.Value, Range("TbSemType[Nom Sem Type]"), Range("TbSemType[Lundi AM Début]"))
        Sheets("Archives").Cells(LigCible + 4, ColCible).Value = Application.WorksheetFunction.XLookup(UsfEffectif.CbSemTypeFixe.Value, Range("TbSemType[Nom Sem Type]"), Range("TbSemType[Lundi AM Fin]"))
        Sheets("Archives").Cells(LigCible + 5, ColCible).Value = Application.WorksheetFunction.XLookup(UsfEffectif.CbSemTypeFixe.Value, Range("TbSemType[Nom Sem Type]"), Range("TbSemType[Absences Lundi PM]"))
        Sheets("Archives").Cells(LigCible + 6, ColCible).Value = Application.WorksheetFunction.XLookup(UsfEffectif.CbSemTypeFixe.Value, Range("TbSemType[Nom Sem Type]"), Range("TbSemType[Lundi PM Début]"))
        Sheets("Archives").Cells(LigCible + 7, ColCible).Value = Application.WorksheetFunction.XLookup(UsfEffectif.CbSemTypeFixe.Value, Range("TbSemType[Nom Sem Type]"), Range("TbSemType[Lundi PM Fin]"))
      End If
    If RangDuJour = 2 Then
        Sheets("Archives").Cells(LigCible, ColCible).Value = UsfEffectif.TxtNom.Value
        Sheets("Archives").Cells(LigCible + 1, ColCible).Value = UsfEffectif.CbSemTypeFixe.Value
        Sheets("Archives").Cells(LigCible + 2, ColCible).Value = Application.WorksheetFunction.XLookup(UsfEffectif.CbSemTypeFixe.Value, Range("TbSemType[Nom Sem Type]"), Range("TbSemType[Absences Mardi AM]"))
        Sheets("Archives").Cells(LigCible + 3, ColCible).Value = Application.WorksheetFunction.XLookup(UsfEffectif.CbSemTypeFixe.Value, Range("TbSemType[Nom Sem Type]"), Range("TbSemType[Mardi AM Début]"))
        Sheets("Archives").Cells(LigCible + 4, ColCible).Value = Application.WorksheetFunction.XLookup(UsfEffectif.CbSemTypeFixe.Value, Range("TbSemType[Nom Sem Type]"), Range("TbSemType[Mardi AM Fin]"))
        Sheets("Archives").Cells(LigCible + 5, ColCible).Value = Application.WorksheetFunction.XLookup(UsfEffectif.CbSemTypeFixe.Value, Range("TbSemType[Nom Sem Type]"), Range("TbSemType[Absences Mardi PM]"))
        Sheets("Archives").Cells(LigCible + 6, ColCible).Value = Application.WorksheetFunction.XLookup(UsfEffectif.CbSemTypeFixe.Value, Range("TbSemType[Nom Sem Type]"), Range("TbSemType[Mardi PM Début]"))
        Sheets("Archives").Cells(LigCible + 7, ColCible).Value = Application.WorksheetFunction.XLookup(UsfEffectif.CbSemTypeFixe.Value, Range("TbSemType[Nom Sem Type]"), Range("TbSemType[Mardi PM Fin]"))
      End If
    If RangDuJour = 3 Then
        Sheets("Archives").Cells(LigCible, ColCible).Value = UsfEffectif.TxtNom.Value
        Sheets("Archives").Cells(LigCible + 1, ColCible).Value = UsfEffectif.CbSemTypeFixe.Value
        Sheets("Archives").Cells(LigCible + 2, ColCible).Value = Application.WorksheetFunction.XLookup(UsfEffectif.CbSemTypeFixe.Value, Range("TbSemType[Nom Sem Type]"), Range("TbSemType[Absences Mercredi AM]"))
        Sheets("Archives").Cells(LigCible + 3, ColCible).Value = Application.WorksheetFunction.XLookup(UsfEffectif.CbSemTypeFixe.Value, Range("TbSemType[Nom Sem Type]"), Range("TbSemType[Mercredi AM Début]"))
        Sheets("Archives").Cells(LigCible + 4, ColCible).Value = Application.WorksheetFunction.XLookup(UsfEffectif.CbSemTypeFixe.Value, Range("TbSemType[Nom Sem Type]"), Range("TbSemType[Mercredi AM Fin]"))
        Sheets("Archives").Cells(LigCible + 5, ColCible).Value = Application.WorksheetFunction.XLookup(UsfEffectif.CbSemTypeFixe.Value, Range("TbSemType[Nom Sem Type]"), Range("TbSemType[Absences Mercredi PM]"))
        Sheets("Archives").Cells(LigCible + 6, ColCible).Value = Application.WorksheetFunction.XLookup(UsfEffectif.CbSemTypeFixe.Value, Range("TbSemType[Nom Sem Type]"), Range("TbSemType[Mercredi PM Début]"))
        Sheets("Archives").Cells(LigCible + 7, ColCible).Value = Application.WorksheetFunction.XLookup(UsfEffectif.CbSemTypeFixe.Value, Range("TbSemType[Nom Sem Type]"), Range("TbSemType[Mercredi PM Fin]"))
      End If
    If RangDuJour = 4 Then
        Sheets("Archives").Cells(LigCible, ColCible).Value = UsfEffectif.TxtNom.Value
        Sheets("Archives").Cells(LigCible + 1, ColCible).Value = UsfEffectif.CbSemTypeFixe.Value
        Sheets("Archives").Cells(LigCible + 2, ColCible).Value = Application.WorksheetFunction.XLookup(UsfEffectif.CbSemTypeFixe.Value, Range("TbSemType[Nom Sem Type]"), Range("TbSemType[Absences Jeudi AM]"))
        Sheets("Archives").Cells(LigCible + 3, ColCible).Value = Application.WorksheetFunction.XLookup(UsfEffectif.CbSemTypeFixe.Value, Range("TbSemType[Nom Sem Type]"), Range("TbSemType[Jeudi AM Début]"))
        Sheets("Archives").Cells(LigCible + 4, ColCible).Value = Application.WorksheetFunction.XLookup(UsfEffectif.CbSemTypeFixe.Value, Range("TbSemType[Nom Sem Type]"), Range("TbSemType[Jeudi AM Fin]"))
        Sheets("Archives").Cells(LigCible + 5, ColCible).Value = Application.WorksheetFunction.XLookup(UsfEffectif.CbSemTypeFixe.Value, Range("TbSemType[Nom Sem Type]"), Range("TbSemType[Absences Jeudi PM]"))
        Sheets("Archives").Cells(LigCible + 6, ColCible).Value = Application.WorksheetFunction.XLookup(UsfEffectif.CbSemTypeFixe.Value, Range("TbSemType[Nom Sem Type]"), Range("TbSemType[Jeudi PM Début]"))
        Sheets("Archives").Cells(LigCible + 7, ColCible).Value = Application.WorksheetFunction.XLookup(UsfEffectif.CbSemTypeFixe.Value, Range("TbSemType[Nom Sem Type]"), Range("TbSemType[Jeudi PM Fin]"))
      End If
    If RangDuJour = 5 Then
        Sheets("Archives").Cells(LigCible, ColCible).Value = UsfEffectif.TxtNom.Value
        Sheets("Archives").Cells(LigCible + 1, ColCible).Value = UsfEffectif.CbSemTypeFixe.Value
        Sheets("Archives").Cells(LigCible + 2, ColCible).Value = Application.WorksheetFunction.XLookup(UsfEffectif.CbSemTypeFixe.Value, Range("TbSemType[Nom Sem Type]"), Range("TbSemType[Absences Vendredi AM]"))
        Sheets("Archives").Cells(LigCible + 3, ColCible).Value = Application.WorksheetFunction.XLookup(UsfEffectif.CbSemTypeFixe.Value, Range("TbSemType[Nom Sem Type]"), Range("TbSemType[Vendredi AM Début]"))
        Sheets("Archives").Cells(LigCible + 4, ColCible).Value = Application.WorksheetFunction.XLookup(UsfEffectif.CbSemTypeFixe.Value, Range("TbSemType[Nom Sem Type]"), Range("TbSemType[Vendredi AM Fin]"))
        Sheets("Archives").Cells(LigCible + 5, ColCible).Value = Application.WorksheetFunction.XLookup(UsfEffectif.CbSemTypeFixe.Value, Range("TbSemType[Nom Sem Type]"), Range("TbSemType[Absences Vendredi PM]"))
        Sheets("Archives").Cells(LigCible + 6, ColCible).Value = Application.WorksheetFunction.XLookup(UsfEffectif.CbSemTypeFixe.Value, Range("TbSemType[Nom Sem Type]"), Range("TbSemType[Vendredi PM Début]"))
        Sheets("Archives").Cells(LigCible + 7, ColCible).Value = Application.WorksheetFunction.XLookup(UsfEffectif.CbSemTypeFixe.Value, Range("TbSemType[Nom Sem Type]"), Range("TbSemType[Vendredi PM Fin]"))
      End If
    If RangDuJour = 6 Then
        Sheets("Archives").Cells(LigCible, ColCible).Value = UsfEffectif.TxtNom.Value
        Sheets("Archives").Cells(LigCible + 1, ColCible).Value = UsfEffectif.CbSemTypeFixe.Value
        Sheets("Archives").Cells(LigCible + 2, ColCible).Value = Application.WorksheetFunction.XLookup(UsfEffectif.CbSemTypeFixe.Value, Range("TbSemType[Nom Sem Type]"), Range("TbSemType[Absences Samedi AM]"))
        Sheets("Archives").Cells(LigCible + 3, ColCible).Value = Application.WorksheetFunction.XLookup(UsfEffectif.CbSemTypeFixe.Value, Range("TbSemType[Nom Sem Type]"), Range("TbSemType[Samedi AM Début]"))
        Sheets("Archives").Cells(LigCible + 4, ColCible).Value = Application.WorksheetFunction.XLookup(UsfEffectif.CbSemTypeFixe.Value, Range("TbSemType[Nom Sem Type]"), Range("TbSemType[Samedi AM Fin]"))
        Sheets("Archives").Cells(LigCible + 5, ColCible).Value = Application.WorksheetFunction.XLookup(UsfEffectif.CbSemTypeFixe.Value, Range("TbSemType[Nom Sem Type]"), Range("TbSemType[Absences Samedi PM]"))
        Sheets("Archives").Cells(LigCible + 6, ColCible).Value = Application.WorksheetFunction.XLookup(UsfEffectif.CbSemTypeFixe.Value, Range("TbSemType[Nom Sem Type]"), Range("TbSemType[Samedi PM Début]"))
        Sheets("Archives").Cells(LigCible + 7, ColCible).Value = Application.WorksheetFunction.XLookup(UsfEffectif.CbSemTypeFixe.Value, Range("TbSemType[Nom Sem Type]"), Range("TbSemType[Samedi PM Fin]"))
      End If
End Sub
 
Vote positif 0 Vote négatif
E

eric72

XLDnaute Accro
Bonjour à tous,
En cherchant un peu j'ai trouvé ce code qui fonctionne mais encore un peu long, par contre beaucoup moins de lignes de code!!!
VB: 
Sub Test()
Dim i As Variant
Dim cel As Range
 
Dim plage As Range, nb_copie As Long
nb_copie = 500
For i = 1 To nb_copie

For Each cel In Range("3:162")
If cel.Value = UsfEffectif.TxtNom.Value Then
Set plage = cel.Offset(0, 0).Resize(8, 7)
Exit For
End If
Next
plage.Copy plage.Offset(0, plage.Columns.Count * i)
Cells(1, plage.Columns.Count * 2 + 1).Value = Cells(1, plage.Columns.Count)
Next i

End Sub

Ca vient tout doucement...
 
Vote positif 0 Vote négatif
E

eric72

XLDnaute Accro
ChTi160 à dit:
Bon jour Eric
à quoi correspond le :

Sois au pis :
500*159=79500

je regarde de mon côté ce que je pourrais apporter Lol !
Question , Ton planning contiendra combien de Lignes (Noms) ?
Bonne journée
Jean marie
Cliquez pour agrandir...
La copie ne se fera que sur 8 lignes à chaque fois pas sur 159, le planning d'une personne est composée de 8 données :
- Le nom
- Le nom de la semaine type
- absence du matin
- Heure début matin
- heure fin matin
- absence après-midi
- Heure début après-midi
- heure fin après-midi
 
Vote positif 0 Vote négatif
E

eric72

XLDnaute Accro
ChTi160 à dit:
re
Question , Ton planning contiendra combien de Lignes (Noms) ?

jean marie
Cliquez pour agrandir...
Avec cette formule je suis à 8 secondes pour 500 fois
VB: 
Sub Test()

Dim i As Variant

Dim cel As Range

 

Dim plage As Range, nb_copie As Long

nb_copie = 500

For i = 1 To nb_copie



For Each cel In Range("3:162")

If cel.Value = UsfEffectif.TxtNom.Value Then

Set plage = cel.Offset(0, 0).Resize(8, 7)

Exit For

End If

Next

plage.Copy plage.Offset(0, plage.Columns.Count * i)

Cells(1, plage.Columns.Count * 2 + 1).Value = Cells(1, plage.Columns.Count)

Next i



End Sub
 
Vote positif 0 Vote négatif
E

eric72

XLDnaute Accro
ChTi160 à dit:
Bonsoir le Fil
Je ne suis pas très dispo Lol
Donc pour être Clair, "ton Planning contiendra 160 Noms"
je n'ai pas compris

J'ai remarqué que ta feuille Planning ne Contient en Colonne "A" que des Noms de 1 à 12
Le principal c'est que ça avance
Bonne fin de Soirée.
Jean Marie
Cliquez pour agrandir...
Bonsoir Jean-Marie,
En fait la version définitive contient 20 noms, pour chaque nom il y a 8 lignes:
Nom
Semaine type
Absence matin
début matin
fin matin
Absence après-midi
début après-midi
fin après-midi
Soit au total 8 x 20 = 160 lignes mais que 8 à dupliquer sur beaucoup de semaines et cela pour chaque nom lors de l'entrée de l'équipier dans l'entreprise lorsqu'on lui attribue une semaine type.
Bonne soirée et merci beaucoup.
Eric
 
Vote positif 0 Vote négatif
E

eric72

XLDnaute Accro
Bonjour à tous,
Je suis toujours avec mon Planning, ça avance bien mais je rencontre de nouveau un problème, je m'explique:
- Onglet Planning, quand je sélectionne une semaine d'une année, je récupère bien tous les plannings de chacun, en parallèle j'ai un tableau qui s'appelle TbCauseAbs que je remplis pour inscrire les congés, les maladie etc...
- J'aimerais dans mon "Planning" que lorsqu'un collaborateur apparait dans le planning, si une absence est renseignée pour cette date que cela s'incrive dans les colonnes correspondantes à savoir pour le lundi (d:g) pour le mardi (l:eek:) etc...
- J'ai débuté une macro (module1) avec "test" et "NoterAbsence" mais cela ne correspond pas.
Avez-vous une petite idée?
Merci beaucoup une nouvelle fois
 

Pièces jointes

  • test.xlsm
    343.2 KB · Affichages: 5
Vote positif 0 Vote négatif

Discussions similaires

thunder23
  • Résolu(e)
XL 2019 Remplir et modifier un tableau à partir d'un userform
2
Réponses
27
Affichages
2 K
ChTi160
ChTi160
B
  • Question
XL 2016 UserForm qui valide ou invalide
Réponses
13
Affichages
892
babacool22
B
L
  • Question
XL 2010 rechercher une valeur pour remplir un label de userform à partir d'une valeur de textbox
2 3 4
Réponses
52
Affichages
4 K
SDHABARKA
S
M
  • Question
XL 2019 remplir un tableau de planning avec userform
Réponses
8
Affichages
2 K
jcf6464
jcf6464
CGU2022.
  • Question
XL 2013 modifier article avec de listbox a text box et retour feuil
Réponses
10
Affichages
1 K
ChTi160
ChTi160
L
  • Question
XL 2019 Trier une liste de noms latins en couleur sans doublons depuis une combobox d'un userform
2
Réponses
29
Affichages
2 K
lusert
L
G
  • Question
XL 2010 Création de planning complexe
Réponses
1
Affichages
2 K
guilou339
G
M
  • Question
XL 2019 Création de VBA pour Userform pour formulaire
2
Réponses
15
Affichages
3 K
cp4
cp4
N
  • Résolu(e)
XL 2016 Comment filtrer une listbox a mesure qu'on saisie dans textbox (2 colonnes)
2
Réponses
21
Affichages
4 K
ChTi160
ChTi160
T
  • Question
XL 2016 Modification de données sur 2 feuilles différentes via UserForm
Réponses
14
Affichages
2 K
tontonboulii
T

Membres actuellement en ligne

17 membres et 315 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
314 422
Messages
2 109 447
Membres
110 482
dernier inscrit
ilyxxxh