[Excel 2010] Calendrier horizontal

Y compris Power BI, Power Query et toute autre question en lien avec Excel
a
amazigh42
Membre habitué
Membre habitué
Messages : 66
Inscrit le : 10 juillet 2009
Version d'Excel : 2007

Message par amazigh42 » 27 janvier 2015, 15:57

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
Avatar du membre
Cappe Pierre
Membre impliqué
Membre impliqué
Messages : 1'997
Appréciations reçues : 8
Inscrit le : 24 novembre 2012
Version d'Excel : 2010

Message par Cappe Pierre » 27 janvier 2015, 17:15

Bonjour,
Il existe dans Excel des calendriers tout fait
donne nous un exemple de ce que tu souhaites et on avisera ensuite
Amicalement
,
Pierrot
Pierrot
a
amazigh42
Membre habitué
Membre habitué
Messages : 66
Inscrit le : 10 juillet 2009
Version d'Excel : 2007

Message par amazigh42 » 3 février 2015, 07:25

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
Avatar du membre
Cappe Pierre
Membre impliqué
Membre impliqué
Messages : 1'997
Appréciations reçues : 8
Inscrit le : 24 novembre 2012
Version d'Excel : 2010

Message par Cappe Pierre » 3 février 2015, 08:26

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
Pierrot
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message