Creation d'un fichier
Bonjour à tous étant plus que novice en la matière je me retourne vers vous pour créer un fichier qui me permettrai de gérer mes menus.
J'imagine que vous allez vous dire oui elle a qu'a chercher un peu !!!! Ce n'est pas faux mais je ne comprends rien !!!
Je vous joint un fichier avec les explications ceci étant le départ de mon futur fichier.
il faudra ensuite que j'ajoute le menu dans la feuille matrice et voir comment on peut faire des copier coller suivant les n°de semaine et suivant le lieu choisi.
Un grand merci d'avance pour l'aide que vous pourrez m'apporter et surtout j’espère pouvoir comprendre un peu plus le fonctionnement d'excel.
Cordialement Gwen.
Hello,
As-tu déjà jeté un oeil ici https://www.excel-pratique.com/fr/telechargements/telechargements.php ? Tu y trouveras peut-être ton bonheur, ou en tout cas une structure sur laquelle t'appuyer et la modeler à ta convenance
Bonjour merci pour l'info le soucis est que je n'y connais rien en langage vba et en formule excel c'est pour cela que je me retourne vers vous .
C'est un vrai cours particulier qu'il me faut !!!!
Hello,
J'entends bien ; mais ce que je te propose c'est de chercher un pattern qui te convient et ensuite on part de là pour l'adapter à tes besoins. Pourquoi créer un fichier de zero si on peut en modifier un existant ?
je suis en train de travailler dessus car je n'ai pas trouvé ce que je cherche.
Pouvez vous m'aider sur ce point il doit exister une formule pour faire ce que je souhaite
voir fichier joint
Semaine 1 correspond a menu 1
merci d'avance.
Ok. Je te cacherai pas qu'il faut plus qu'une simple formule pour faire ça. Je pense que le terme "galère" est approprié ici
Quel est le but de ces lignes ? Qu'est-ce qui sera inscrit en-dessous ?
voici mon tableau j'ai un peu avancé avec le peu de connaissance que j'ai.
Je voudrais plus tard que sur la feuille ouverture classeur ça soit un userform mais bon on en est la !!! j'ai creer un bouton pour choisir ehpad ou mapa je ne c'est pas si il y a une autre technique.
je voudrai dans la feuille matrice que quand je choisi l'année ca me mette les semaine sous cette forme "Du 01 au 07 Janvier 2015".
Car le but est de pouvoir choisir sur la feuille ouverture classeur une année ; un numéro de semaine et que ça me recopie dans la feuille exemple fini
la cellule G4 ; A4 ; A7 et si possible les cellules b10 a b40 avec le bon n° de jour et pour finir copier le menu correspondant au menu n° de la semaine puis ca recopierai sur une autre feuille que je nommerai "menu journalier" avec une mise en forme speciale le menu du midi et le menu du soir sur une autre feuille.
Voila je suis super compliquée vous pouvez le dire !!!!
Encore merci de me répondre.
ps j'ai beau parcourir les fichiers de votre lien je ne trouve pas de correspondance.
Bon bon.
Le projet en soi n'est pas si compliqué, mais il y a tellement de choses que je ne comprends pas dans ton projet et tes explications...
Bref en attendant, une proposition brouillonne (j'ai modifié en 5mn un code que j'utilise donc il y a plein d'étapes inutiles) pour générer ta feuille "matrice"
L'année t'es demandée au lancement de la macro.
Option Explicit
Global varan%
Sub Proposition()
Application.ScreenUpdating = False 'On désactive ces fonctionnalités
Application.Calculation = xlCalculationManual
Sheets.Add
Calendrier
Semaines_mois
Application.ScreenUpdating = True 'On désactive ces fonctionnalités
Application.Calculation = xlCalculationAutomatic
End Sub
Public Sub Semaines_mois()
Dim aCell As Range, oCell As Range
Dim K As Integer, lR As Integer
With Range("b1:b1000")
.NumberFormat = """S""00" 'Format Sxx pour les semaines
.Font.Bold = True
End With
lR = Range("c1000").End(xlUp).Row
For K = 2 To lR 'On balaye la colonne C
If IsDate(Cells(K, 3)) Then
Set aCell = Cells(K, 3)
aCell.EntireRow.Insert
aCell.Offset(-1, -2).EntireRow.Interior.Color = 13082801
aCell.Offset(-1, -2).Formula = "=PROPER(TEXT(" & aCell.Address & ", ""mmmm aaaa""))"
K = K + 1
Set oCell = Cells(K, 3)
If CLng(CDate(Last_Monday(CDate(oCell)))) = CLng(CDate(oCell)) Then oCell.Offset(-1, -1).Formula = "=NO.SEMAINE(" & oCell.Address & ")"
Exit For
End If
Next
While K < lR 'On balaye la colonne C. On utilise While car il faut actualiser l'itération max (lR) en cours de boucle (vu qu'on insère des lignes)
If IsDate(Cells(K, 3)) Then
If Month(Cells(K, 3)) <> Month(aCell) Then
Set aCell = Cells(K, 3)
aCell.EntireRow.Insert
aCell.Offset(-1, -2).EntireRow.Interior.Color = 13082801
aCell.Offset(-1, -2).Formula = "=PROPER(TEXT(" & aCell.Address & ", ""mmmm aaaa""))"
K = K + 1
End If
If SailWeek(CDate(Cells(K, 3))) <> SailWeek(CDate(oCell)) Then
Cells(K, 3).EntireRow.Insert
Cells(K, 3).EntireRow.Interior.Color = 16315374
Cells(K, 3).Offset(0, -1).Formula = "=WEEKNUM(" & oCell.Address & ")"
Cells(K, 3).Offset(0, 1) = "Semaine du " & CDate(oCell) & " au " & (CDate(oCell - Weekday(oCell, 2) + 7))
Range(Cells(K, 3).Offset(0, 1), Cells(K, 3).Offset(0, 10)).Merge
K = K + 1
Set oCell = Cells(K, 3)
End If
End If
lR = Range("c1000").End(xlUp).Row
K = K + 1
Wend 'prochaine itération
Range("A1:A" & lR).Font.Bold = True
Range(Cells(1, 1), Cells(lR, 15)).Copy
Range(Cells(1, 1), Cells(lR, 15)).PasteSpecial (xlPasteValues)
Range(Cells(1, 1), Cells(lR, 15)).PasteSpecial (xlPasteFormats)
For K = lR To 1 Step -1
If Cells(K, 3).Interior.Color = 8421504 Then Cells(K, 3).EntireRow.Delete
Next
End Sub
Sub Calendrier()
Dim DS As Date, DSY As Date
Dim I As Integer, Result As Integer
If varan <> 0 Then
DS = DateSerial(varan, 1, 1)
DSY = DateValue("31 décembre " & varan)
For I = 0 To DSY - DS
'If Weekday(DS + I, vbMonday) < 6 Then
Range("c1000").End(xlUp).Offset(1, 0) = DS + I
With Range("c1000").End(xlUp)
.NumberFormat = "m/d/yyyy"
.Font.Bold = True
.Interior.ThemeColor = xlThemeColorDark1
.Interior.TintAndShade = -0.499984740745262
End With
'End If
Next I
Else: Result = MsgBox("Vous n'avez pas renseigné l'année !" & vbCrLf & "Cliquez sur OK pour renseigner la donnée manquante ou sur annuler pour quitter.", vbOKCancel, "Donnée manquante")
Select Case Result
Case Is = 2
Exit Sub
Case Is = 1
varan = Val(InputBox("Année ?", "CALENDRIER"))
Calendrier
End Select
End If
End Sub
Function Last_Monday(vDate As Date)
'if today is Monday, then return today's date
If Weekday(vDate, vbSunday) = 2 Then
Last_Monday = vDate
Else
Last_Monday = vDate - Weekday(vDate, vbSunday) + 2
End If
End Function
' This function was created by Sailesh Kr Mishra (91-9958050139)
' while he was required to pull weekly report using dates of the month
Function SailWeek(dDate1 As Date) As String
Dim dDate2 As String
Dim wWeek As Integer
'dDate2 is changed to date from String
dDate2 = VBA.CDate(Month(dDate1) & "/01/" & Year(dDate1))
wWeek = DateDiff("ww", dDate2, dDate1, vbMonday, vbUseSystem) + 1
'Return the Week number of the month
'Monday is taken as week starting date, you can change
'it to your desired day as starting date of week
SailWeek = wWeek
End Functionbonjour ton code est pas mal pour les semaines le soucis c'est qu'une fois que tu as choisi une année c'est bloqué tu ne peux plus changer d'année après
Je continue de mon coté afin d'éclaircir un peu
encore merci.
alors :
* première question comment fait on pour ne pas avoir l’écran qui saute quand je clic sur le bouton EHPAD ou le bouton MAPA?
Ensuite j'ai récupéré un calendrier d'un tableau que j'ai trouvé je ne comprends pas tout mais bon pas grave ça fonctionne
je ne comprends pas comment placer ton code; car quand je fais exécuter la macro ça fonctionne ça me donne les semaines sur une autre feuille ça c'est cool .
j'ai ajouté un bouton TEST sur la feuille ouverture classeur
si je choisi l'année 2015
la semaine n°2 (pour avoir une semaine entière)
je clic sur le bouton TEST ça me recopie dans la feuille exemple fini:
* MENU 2
* SEMAINE 2
* Semaine du 05 au 11 Janvier 2015
* les n° des jours
* le menu fini
Et ensuite ça me recopierai le menu sur une autre feuille avec une écriture définie et un cadre style menu de restaurant
je n'ai pas encore crée cette feuille
J’espère être un peu plus clair !!!
Heu j'allais oublié le principal comment fait on pour choisir n’importe quelle année et n'importe quelle semaine et hop magie !!! ça recopie le menu !!!!
Alors, l'idée c'était de voir si la mise en forme te convenait.
Maintenant, on va faire en sorte qu'au changement de la cellule concernée (ta liste déroulante), la feuille se régénère ou qu'une nouvelle feuille soit créée.
Je suis pas mal occupé en ce moment, donc fais quelques tests sur plusieurs années. Le code est stable chez moi, et je n'aurai pas le temps de la simplifier ; donc s'il est stable chez toi aussi, on garde ce bricolage.
Mais à la limite, peut-être que le code de base te conviendrait plus.
J'ai simplement modifié le "bricolage" qui faisait que les jours étaient supprimés. (les trois lignes de boucle en fin de sub)
Essaie le code suivant et reviens vers moi
Option Explicit
Global varAn%
Sub Proposition()
Application.ScreenUpdating = False 'On désactive ces fonctionnalités
Application.Calculation = xlCalculationManual
Sheets.Add
Calendrier
Semaines_mois
Application.ScreenUpdating = True 'On désactive ces fonctionnalités
Application.Calculation = xlCalculationAutomatic
End Sub
Public Sub Semaines_mois()
Dim aCell As Range, oCell As Range
Dim K As Integer, lR As Integer
With Range("b1:b1000")
.NumberFormat = """S""00" 'Format Sxx pour les semaines
.Font.Bold = True
End With
lR = Range("c1000").End(xlUp).Row
For K = 2 To lR 'On balaye la colonne C
If IsDate(Cells(K, 3)) Then
Set aCell = Cells(K, 3)
aCell.EntireRow.Insert
aCell.Offset(-1, -2).EntireRow.Interior.Color = 13082801
aCell.Offset(-1, -2).Formula = "=PROPER(TEXT(" & aCell.Address & ", ""mmmm aaaa""))"
K = K + 1
Set oCell = Cells(K, 3)
If CLng(CDate(Last_Monday(CDate(oCell)))) = CLng(CDate(oCell)) Then oCell.Offset(-1, -1).Formula = "=NO.SEMAINE(" & oCell.Address & ")"
Exit For
End If
Next
While K < lR 'On balaye la colonne C. On utilise While car il faut actualiser l'itération max (lR) en cours de boucle (vu qu'on insère des lignes)
If IsDate(Cells(K, 3)) Then
If Month(Cells(K, 3)) <> Month(aCell) Then
Set aCell = Cells(K, 3)
aCell.EntireRow.Insert
aCell.Offset(-1, -2).EntireRow.Interior.Color = 13082801
aCell.Offset(-1, -2).Formula = "=PROPER(TEXT(" & aCell.Address & ", ""mmmm aaaa""))"
K = K + 1
End If
If SailWeek(CDate(Cells(K, 3))) <> SailWeek(CDate(oCell)) Then
Cells(K, 3).EntireRow.Insert
Cells(K, 3).EntireRow.Interior.Color = 16315374
Cells(K, 3).Offset(0, -1).Formula = "=WEEKNUM(" & oCell.Address & ")"
Cells(K, 3).Offset(0, 1) = "Semaine du " & CDate(oCell) & " au " & (CDate(oCell - Weekday(oCell, 2) + 7))
Range(Cells(K, 3).Offset(0, 1), Cells(K, 3).Offset(0, 10)).Merge
K = K + 1
Set oCell = Cells(K, 3)
End If
End If
lR = Range("c1000").End(xlUp).Row
K = K + 1
Wend 'prochaine itération
Range("A1:A" & lR).Font.Bold = True
Range(Cells(1, 1), Cells(lR, 15)).Copy
Range(Cells(1, 1), Cells(lR, 15)).PasteSpecial (xlPasteValues)
Range(Cells(1, 1), Cells(lR, 15)).PasteSpecial (xlPasteFormats)
End Sub
Sub Calendrier()
Dim DS As Date, DSY As Date
Dim I As Integer, Result As Integer
If varan <> 0 Then
DS = DateSerial(varan, 1, 1)
DSY = DateValue("31 décembre " & varan)
For I = 0 To DSY - DS
'If Weekday(DS + I, vbMonday) < 6 Then
Range("c1000").End(xlUp).Offset(1, 0) = DS + I
With Range("c1000").End(xlUp)
.NumberFormat = "m/d/yyyy"
.Font.Bold = True
.Interior.ThemeColor = xlThemeColorDark1
.Interior.TintAndShade = -0.499984740745262
End With
'End If
Next I
Else: Result = MsgBox("Vous n'avez pas renseigné l'année !" & vbCrLf & "Cliquez sur OK pour renseigner la donnée manquante ou sur annuler pour quitter.", vbOKCancel, "Donnée manquante")
Select Case Result
Case Is = 2
Exit Sub
Case Is = 1
varan = Val(InputBox("Année ?", "CALENDRIER"))
Calendrier
End Select
End If
End Sub
Function Last_Monday(vDate As Date)
'if today is Monday, then return today's date
If Weekday(vDate, vbSunday) = 2 Then
Last_Monday = vDate
Else
Last_Monday = vDate - Weekday(vDate, vbSunday) + 2
End If
End Function
' This function was created by Sailesh Kr Mishra (91-9958050139)
' while he was required to pull weekly report using dates of the month
Function SailWeek(dDate1 As Date) As String
Dim dDate2 As String
Dim wWeek As Integer
'dDate2 is changed to date from String
dDate2 = VBA.CDate(Month(dDate1) & "/01/" & Year(dDate1))
wWeek = DateDiff("ww", dDate2, dDate1, vbMonday, vbUseSystem) + 1
'Return the Week number of the month
'Monday is taken as week starting date, you can change
'it to your desired day as starting date of week
SailWeek = wWeek
End Function
Ca ne fonctionne pas chez moi quand je renseigne la date et que je valide ça me dit que je n'ai pas renseigné la date
Tant pis c'est pas le plus important je peux le faire en manuel sur la feuille matrice le soucis c'est pour les autres questions la je bloque
J'ai dit qu'on ALLAIT faire en sorte, normal que ça ne marche pas pour le moment
ok merci pour ton aide
Je viens de m'apercevoir qu'il y a un petit soucis sur les semaines
exemple: il me faut la semaine du lundi au dimanche le souci c'est qu'en fin de mois ça va se chevaucher donc
si semaine 1 = lundi 25 au dimanche 31 Janvier2015 pas de soucis c'est Janvier qui s'affiche
mais si semaine 1 = du lundi 28 au dimanche 3 Février la y a soucis car avec ton code la semaine s'arrête le jeudi.
Je ne sais pas si cela est faisable sinon je le ferai manuellement.
Hello,
Oui, les semaines chevauchent les mois, le code suit la dispo calendaire. Qu'est-ce que tu voudrais à la place?
Sinon, par curiosité, de quelle année parles-tu ?
Envoie moi ton fichier (anonymisé) pour qu'on mette en place la régénération au changement de cellule et l'extraction.
EDIT : Ok, je vois ce que tu veux dire concernant les semaines, je viens de remarquer ça. Je te renvoie ça corrigé bientôt
RE-EDIT :
Modifie la fonction SailWeek par celle-là : (et les appels)
Public Function IsoWeekNumber(InDate As Date) As Long
IsoWeekNumber = DatePart("ww", InDate, vbMonday, vbUseSystem)
End FunctionJe crois que rien d'autre n'a changé.