[Excel 2010] Calendrier horizontal
Bonjour,
Je souhaiterai changer la macro ci-après récupérée sur le NET pour que l'affichage se fasse mode horizontal.
J'ai bien tenté certaines choses mais c'est catastrophique.
Merci par avance de votre aide
Sub planning()
' Oter la protection de la feuille pour prévenir toute erreur.
ActiveSheet.Protect DrawingObjects:=False, Contents:=False, _
Scenarios:=False
' Inhiber le scintillement de la feuille pendant la création du calendrier.
Application.ScreenUpdating = False
' Set up error trapping.
On Error GoTo MyErrorTrap
' Vider la zone a1:g14 y compris tout calendrier précédent.
Range("a1:g14").Clear
' Utilisez InputBox pour obtenir mois et l'année désirée et variable fixé
' MyInput.
MyInput = InputBox("Tapez le mois et l'année du calendrier")
' Permettre à l'utilisateur de mettre fin macro avec Annuler dans InputBox.
If MyInput = "" Then Exit Sub
' Obtenir la valeur de date du début du mois entrées.
StartDay = DateValue(MyInput)
' Vérifiez si la date valide, mais pas le premier du mois.
' -- si oui, réinitialiser StartDay au premier jour du mois.
If Day(StartDay) <> 1 Then
StartDay = DateValue(Month(StartDay) & "/1/" & _
Year(StartDay))
End If
' Préparer la cellule pour le mois et année en toutes lettres.
Range("a1").NumberFormat = "mmmm yyyy"
' Centrer l'étiquette Mois et Année dans a1: g1 avec formatage
' la taille, la hauteur et la mise en gras.
With Range("a1:g1")
.HorizontalAlignment = xlCenterAcrossSelection
.VerticalAlignment = xlCenter
.Font.Size = 18
.Font.Bold = True
.RowHeight = 35
End With
' Preparer le formatage des cellules a2:g2 des jours de la semaine.
' Centrage, taille, hauteur et mise en gras.
With Range("a2:g2")
.ColumnWidth = 11
.VerticalAlignment = xlCenter
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Orientation = xlHorizontal
.Font.Size = 12
.Font.Bold = True
.RowHeight = 20
End With
' Mettez les jours de la semaine dans a2:g2.
Range("a2") = "Dimanche"
Range("b2") = "Lundi"
Range("c2") = "Mardi"
Range("d2") = "Mercredi"
Range("e2") = "Jeudi"
Range("f2") = "Vendredi"
Range("g2") = "Samedi"
' Preparer les cellules dates a3:g3 avec alignement gauche et haut, tailles et hauteur.
' et mise en gras.
With Range("a3:g8")
.HorizontalAlignment = xlRight
.VerticalAlignment = xlTop
.Font.Size = 18
.Font.Bold = True
.RowHeight = 21
End With
' Mettre le mois et l'année tapés en entrée dans "a1".
Range("a1").Value = Application.Text(MyInput, "mmmm yyyy")
' Definir la variable et obtenir le début du jour de la semaine du mois.
DayofWeek = Weekday(StartDay)
' Définir des variables afin d'identifier l'année et le mois en tant
' que variables distinctes.
CurYear = Year(StartDay)
CurMonth = Month(StartDay)
' Definir la variable et calculer le premier jour du mois suivant.
FinalDay = DateSerial(CurYear, CurMonth + 1, 1)
' Placer un "1" dans la cellule position du premier jour du mois sélectionné
' sur la base de DayofWeek.
Select Case DayofWeek
Case 1
Range("a3").Value = 1
Case 2
Range("b3").Value = 1
Case 3
Range("c3").Value = 1
Case 4
Range("d3").Value = 1
Case 5
Range("e3").Value = 1
Case 6
Range("f3").Value = 1
Case 7
Range("g3").Value = 1
End Select
' Bouclage et incrémentation de chaque cellule après celle de "1" suivant la
' plage a3:g8.
For Each cell In Range("a3:g8")
RowCell = cell.Row
ColCell = cell.Column
' Faire si "1" est dans la première colonne.
If cell.Column = 1 And cell.Row = 3 Then
' Faire si cellule courante n'est pas en 1ère colonne.
ElseIf cell.Column <> 1 Then
If cell.Offset(0, -1).Value >= 1 Then
cell.Value = cell.Offset(0, -1).Value + 1
' Arrêt lorsque le dernier jour du mois a été
' entré.
If cell.Value > (FinalDay - StartDay) Then
cell.Value = ""
' Sortie de la boucle quand le calendrier possède le bon nombre de
' jours indiqués.
Exit For
End If
End If
' Faire seulement si la cellule actuelle ne est pas à la ligne 3 et à la colonne 1.
ElseIf cell.Row > 3 And cell.Column = 1 Then
cell.Value = cell.Offset(-1, 6).Value + 1
' Arrêt lorsque le dernier jour du mois a été saisi.
If cell.Value > (FinalDay - StartDay) Then
cell.Value = ""
' Sortie de la boucle lorsque le calendrier a le bon nombre de
' jours indiqués.
Exit For
End If
End If
Next
' Formatage et mise en forme des cellules d'entrées JOUR
For x = 0 To 5
Range("A4").Offset(x * 2, 0).EntireRow.Insert
With Range("A4:G4").Offset(x * 2, 0)
.RowHeight = 65
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlTop
.WrapText = True
.Font.Size = 10
.Font.Bold = False
' Déverrouiller ces cellules pour être en mesure de saisir du texte plus tard.
.Locked = False
End With
' Formatage bordure autour du bloc de dates.
With Range("A3").Offset(x * 2, 0).Resize(2, _
7).Borders(xlLeft)
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Range("A3").Offset(x * 2, 0).Resize(2, _
7).Borders(xlRight)
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
Range("A3").Offset(x * 2, 0).Resize(2, 7).BorderAround _
Weight:=xlThick, ColorIndex:=xlAutomatic
Next
If Range("A13").Value = "" Then Range("A13").Offset(0, 0) _
.Resize(2, 8).EntireRow.Delete
' Inhiber le quadrillage.
ActiveWindow.DisplayGridlines = False
' Protéger la feuille pour éviter d'écraser les dates.
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, _
Scenarios:=True
' Redimensionner la fenêtre pour montrer tout le calendrier (peut-être ajusté pour
' configuration video).
ActiveWindow.WindowState = xlMaximized
ActiveWindow.ScrollRow = 1
' Allow screen to redraw with calendar showing.
Application.ScreenUpdating = True
' Prevent going to error trap unless error found by exiting Sub
' here.
Exit Sub
' Erreur ouvre une fenêtre pour signaler le problème, fournit une nouvelle zone de saisie
' et reprend à la ligne ce qui a provoqué l'erreur.
MyErrorTrap:
MsgBox "Vous n'avez pas entré le Mois ou Année correctement." _
& Chr(13) & "Epelez correctement le mois" _
& " (ou utiliser une abréviation de 3 lettres)" _
& Chr(13) & "et 4 chiffres pour l'année"
MyInput = InputBox("Tapez le mois et l'année du Calendrier")
If MyInput = "" Then Exit Sub
Resume
End Sub
Répondre avec citation Répondre avec citation 0 0
Bonjour,
Il existe dans Excel des calendriers tout fait
donne nous un exemple de ce que tu souhaites et on avisera ensuite
Amicalement
Pierrot
Bonjour,
J'ai peut-être pris un canon pour tuer une mouche mais malgré le choix d'opter pour des formules je n'arrive pas aux résultats escomptés.
En A2 je tape textuellement 2015
En B1 je tape textuellement janvier
Je souhaiterai une formule qui m'afficherait
à partir de B2 le jour mercredi
à partir de B3 la date 01
Ensuite je pourrais mettre
en C2 mettre la formule
=B2+1
et idem en C3
Bien sûr le tout en tenant compte du nombre de jours des différents mois lorsque je taperais en B1 février.
Merci de votre aide
Bonjour, amazigh42
un calendrier tout fait à tester.
Amicalement Pierrot
le calendrier est trop lourd pour être posté ici
envoi-moi ton adresse mail et je te ferai parvenir