Bonjour ,je souhaite pouvoir ,a l’ouverture du fichier pouvoir renseigner l’onglet « FICHE HEURE » à partir de l’onglet « Planning » et l’imprimer (mettre un code couleur sur la date pour éviter d’imprimer a chaque ouverture en disant si vert ne pas réimprimer et faire changer la couleur (en blanc) à chaque changement de dates)
Les éléments à copier sont :
Les OF
les heures affectées a chaque personnes par OF
Ne pas prendre en compte les OF dont le temps de travail est égal a zéro (colonne E dans onglet « Planning »
L’onglet « FEUILLE D’HEURE » a été rempli manuellement pour exemple de ce que je souhaite.
merci pour toute l’aide que vous pourrez m’apporter .
test feuille heure auto-1.xlsm (36,4 Ko)
1 « J'aime »
Bonjour Franck,
J’ai pas vraiment compris, on n’a pas la feuille « FICHE HEURE » sur ton fichier.
C’est normal 
je voulais écrire « Feuille heure » mais c’est une très vieille habitude d’appeler ces feuilles,fiche ,d’où mon lapsus .
L’onglet a prendre en considération est bel et bien l’onglet « FEUILLE HEURE »
Désolé.
Franck.
, t’aurais pas une image de sortie ?, genre un aperçu de résultat ?
L’onglet Feuille heure te montre ce que souhaite obtenir pour la journée d’aujourd’hui.
Sub Ouverture()
Dim shFH
Dim Lignes: Lignes = 13
Set shFH = Sheets("Feuille Heure ")
With shFH.Range("A6:S18")
.ClearContents
.EntireRow.Hidden = False
End With
With Sheets("planning")
s = Evaluate("TEXT('feuille heure '!b2,""[$-fr-FR]dddd dd mmmm yyyy"")")
r = Application.Match(s, .Columns("A"), 0)
If IsNumeric(r) Then
shFH.Cells(6, "A").Resize(Lignes).Value = .Range("V" & r + 3).Resize(Lignes).Value
For i = 0 To 5
shFH.Cells(6, 2 + i * 3).Resize(Lignes).Value = .Range("F" & r + 3).Resize(Lignes).Offset(, i).Value
Next
With shFH
On Error Resume Next
.Range("A6:A18").SpecialCells(xlBlanks).EntireRow.Hidden = True
On Error GoTo 0
.PrintPreview
End With
Else
MsgBox "problème"
End If
End With
End Sub
Merci cow18 !!
Çà fonctionne mais j’aurai souhaité que lorsque le temps de travail est egale à zéro les OF ne soient pas recopié :
Ils sont recopiés et du coup remplissent le tableau pour rien :
Autre souhait, car le fichier est amené a être ouvert et consulté plusieurs fois par jour ,il serait interessant donc qu’on ne puisse automatiquement et ne l’imprimer qu’une seule fois à la première ouverture ,est ce possible ?
Merci .
Franck .
j’ai fait une tentative pour la coloration de la date et ainsi bloquer l’exécution de la macro :
Sub Ouverture()
Dim shFH
Dim Lignes: Lignes = 13
Set shFH = Sheets(« FEUILLE HEURE »)
With shFH.Range(« A6:S18 »)
.ClearContents
.EntireRow.Hidden = False
If Sheets(« FEUILLE HEURE »).Range(« B2 »).Interior.ColorIndex = 4 Then Exit Sub
End With
With Sheets("planning")
s = Evaluate("TEXT('FEUILLE HEURE'!b2,""[$-fr-FR]dddd dd mmmm yyyy"")")
r = Application.Match(s, .Columns("A"), 0)
If IsNumeric(r) Then
shFH.Cells(6, "A").Resize(Lignes).Value = .Range("V" & r + 3).Resize(Lignes).Value
For i = 0 To 5
shFH.Cells(6, 2 + i * 3).Resize(Lignes).Value = .Range("F" & r + 3).Resize(Lignes).Offset(, i).Value
Next
Sheets("FEUILLE HEURE").Range("B2").Interior.ColorIndex = 4
With shFH
On Error Resume Next
.Range("A6:A18").SpecialCells(xlBlanks).EntireRow.Hidden = True
On Error GoTo 0
.PrintPreview
End With
Else
MsgBox "problème"
End If
End With
End Sub
C’est tout bon !!
Merci encore une fois pour ton aide précieuse !!
Fichier fonctionnel et conforme aux souhaits que j’ai émis .
Mais a l’utilisation je me rend compte que j’ai oublié une notion qui a son importance ,désolé !!
Pour chaque jour de la semaine j’ai des noms de personnel dans les cellules en dessous de la date ,ces prénoms peuvent varier suivant les absents.
Peut-on en même temps que les autres éléments copier ces prénoms dans l’onglet feuille heure a partir du planning ?
Super boulot !!
Franck.
re,
pour le moment dans ce FOR…NEXT-loop, on ne fait qu’une chose, il faut ajouter une 2ième, celle du nom de la personne
For i = 0 To 5
>>>>>>>cette ligne>>>> shFH.Cells(4, 2 + i * 3).Value = .Range("F" & r + 1).Offset(, i).Value 'nom de la personne
shFH.Cells(6, 2 + i * 3).Resize(Lignes).Value = .Range("F" & r + 3).Resize(Lignes).Offset(, i).Value 'heures
Next
1 « J'aime »
Merci beaucoup Cow18 ,
Bingo !!
Fichier terminé et hyper fonctionnel !!
Un grand merci !
Franck .
Une dernière interrogation,si je transposé les dates au format date et non texte , comment dois je modifier la formule :
S=Evaluate (« TEXT(aujourd_hui, »« [$-fr-FR]dddd dd mmmm yyyy »« ) »)
Pour avoir aujourd’hui en format date .
Merci
Franck.
alors, on n’a plus besoin de ce « s », on prend cLng(date)
With Sheets(« planning »)
r = Application.Match(CLng(Date), .Columns(« A »), 0) 'rechercher dans la colonne A
If IsNumeric(r) Then 'trouvé
…
Super !
cela me permet d’utiliser ce fichier pour deux application .
Derniere requete ,j’ai une copie d’onglet qui ne me donne pas entière satisfaction ,je souhaite recopier a l’identique ,mise en forme comprise (de l’onglet « Planning » vers l’onglet « ph ») en utlisant le bouton ;« copie vers ph ».
Peux tu me retailler la macro pour etre un peu plus élégant dans la mise en forme ?
Franck .
test feuille heure auto-1.xlsm (71,3 Ko)
je ne sais pas ce que vous voulez copier&coller avec format, il faut utiliser copy and paste, mais quoi ?
J’ai ajouté un camera, juste en dessous.
test feuille heure auto-1 (1).xlsm (99,8 Ko)
Bonjour et merci ,je voulais simplement copier la feuille « Planning » dans la feuille « ph » ,a l’identique mais lorsque je copie/colle le tableau n’est pas copié dans les mêmes cellules…
Par contre l’idée de caméra est super intéressante,a garder .
Merci pour tout.
Franck.
Ce sujet a été automatiquement fermé après 30 jours. Aucune réponse n’est permise dorénavant.