[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