calendrier sur une colonne

• hoerwind à dit:

  (…)
  Il ne faut pas réinventer ce qui est prévu nativement sur Excel : menu Édition - Série
  (…)

  Cliquez pour agrandir...

  On fait ce qu'on veut, d'autant que je doute que la fonction de remplissage en série native puisse appliquer la fonte Verdana, corps 10 et un format personnalisé à la série créée. Mais il n'est pas impossible que j'ignore les finesses de cette fonction intégrée.
  
  Ceci dit, on peut simplifier le code en utilisant la méthode DataSeries, si on n'a pas à déployer une série de dates présentant des singularités (par exemple : exclusion des mercredis). Voici une possibilité, incluant le choix de la disposition en ligne ou en colonne :
  VB:

  Sub Calendrier() ' construit un calendrier dans une ligne ou une colonne
  ' choix de la cellule de départ par l'utilisateur
  ' choix des dates de début et fin de calendrier
  Dim deb&, fin&, msg$, HV As Boolean
  Dim Cell As Range
   
    msg = "Date invalide."
    On Error GoTo E
    deb = CDate(InputBox("Première date du calendrier :"))
    fin = CDate(InputBox("Dernière date du calendrier :"))
    If fin < deb Then Exit Sub
    Set Cell = Application.InputBox(Prompt:="Sélectionnez la cellule où commence le calendrier", Type:=8)
    On Error GoTo 0
    HV = MsgBox("Orientation horizontale ?", vbYesNo) = vbYes
    With Cell.Resize((1 + HV) * (fin - deb) + 1, HV * (deb - fin) + 1)
      .NumberFormatLocal = "jjj jj mmm aa"
      .Font.Name = "Verdana"
      .Font.Size = 10
      .HorizontalAlignment = xlCenter
      .VerticalAlignment = xlCenter
      .Value = deb
      .DataSeries Rowcol:=2 + HV, Type:=xlChronological, Date:=xlDay, Step:=1, Trend:=False
    End With
  Exit Sub
  
  E:
    MsgBox msg
    Resume
  End Sub

• natorp à dit:

  (…)
  Roger : et si l'on veut construire ce calendrier sur une ligne, que faut-il changer dans le code ?
  (…)

  Cliquez pour agrandir...

  Il suffit de remplacer
  VB:

    With Cell.Resize(fin - deb + 1, 1)

  par
  VB:

    With Cell.Resize(1, fin - deb + 1)

  et
  VB:

      .Value = dat

  par
  VB:

      .Value = WorksheetFunction.Transpose(dat)

  On peut aussi faire une version donnant le choix de la disposition (comme dans l'exemple donné plus haut) :
  VB:

  Sub Calendrier1() ' construit un calendrier dans une ligne ou une colonne
  ' choix de la cellule de départ par l'utilisateur
  ' choix des dates de début et fin de calendrier
  Dim deb&, fin&, i&, dat&(), msg$, HV As Boolean
  Dim Cell As Range
   
    msg = "Date invalide."
    On Error GoTo E
    deb = CDate(InputBox("Première date du calendrier :"))
    fin = CDate(InputBox("Dernière date du calendrier :"))
    If fin < deb Then Exit Sub
    Set Cell = Application.InputBox(Prompt:="Sélectionnez la cellule où commence le calendrier", Type:=8)
    On Error GoTo 0
    HV = MsgBox("Orientation horizontale ?", vbYesNo) = vbYes
    ReDim dat(1 To fin - deb + 1, 1 To 1) '***
     For i = CLng(deb) To CLng(fin): dat(i - deb + 1, 1) = i: Next '***
     With Cell.Resize((1 + HV) * (fin - deb) + 1, HV * (deb - fin) + 1) '***
       .NumberFormatLocal = "jjj jj mmm aa"
      .Font.Name = "Verdana"
      .Font.Size = 10
      .HorizontalAlignment = xlCenter
      .VerticalAlignment = xlCenter
      If HV Then .Value = WorksheetFunction.Transpose(dat) Else .Value = dat
    End With
  Exit Sub
  
  E:
    MsgBox msg
    Resume
  End Sub

  En bricolant les lignes marquées '***, on peut adapter la série de dates à toutes les exigences particulières qu'on veut.

natorp à dit:

Merci beaucoup, mais j'ai une erreur quand je choisis "horizontal" :
"erreur définie par l'application ou par l'objet"
à la ligne :

Code:

  With Cell.Resize((1 + HV) * (fin - deb) + 1, HV * (deb - fin) + 1) '***

Gérard

Cliquez pour agrandir...

natorp à dit:

Ben oui ça marche....
Je ne comprends pas... j'ai refait un copier/coller dans mon fichier et ça marche ....!!!

désolé pour le dérangement...merci

Gérard

Cliquez pour agrandir...