Comment modifier ce code afin de générer calendrier annuel 1904 sur une colonne...

C

Christian0258

XLDnaute Accro
Bonjour à tout le forum,

Je souhaiterais votre aide afin de modifier ce code, auteur Hoerwind, afin de ne générer que l'année souhaitée et non les 1462 jours qui suivent... (calendrier 1904 coché) :

Sub test() 'merci hoerwind ;)
Dim ChxAn$, fin&, Debut
ChxAn = InputBox("Saisir l'année de votre calendrier", "Calendrier", Year(Date))
[a5] = DateValue("1/1/" & ChxAn)
fin = CLng(DateValue("31/12/" & ChxAn))
[a5].DataSeries 2, 3, 1, 1, fin, False
End Sub

Merci pour le temps que vous voudrez bien vouloir m'accorder.

Bien à vous,
Christian
 
Trier par date Trier par votes
C

Christian0258

XLDnaute Accro
Re : Comment modifier ce code afin de générer calendrier annuel 1904 sur une colonn

Re, le forum, job75,

Salut job75, merci pour ta réponse.
Sauf erreur de ma part si "calendrier1904" est coché le calendrier ainsi généré place des dates jusqu'à la ligne 1831...

A te lire,
Christian
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : Comment modifier ce code afin de générer calendrier annuel 1904 sur une colonn

Re,

J'avions point regardé en bas... Alors :

Code: 
Sub test()
Dim ChxAn$, fin&, Debut
ChxAn = InputBox("Saisir l'année de votre calendrier", "Calendrier", Year(Date))
[a5] = DateValue("1/1/" & ChxAn)
fin = CLng(DateValue("31/12/" & ChxAn)) + 1462 * ThisWorkbook.Date1904
[a5].DataSeries 2, 3, 1, 1, fin, False
End Sub
A+
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : Comment modifier ce code afin de générer calendrier annuel 1904 sur une colonn

Re,

Pour éviter tout problème s'il y a plusieurs classeurs :

Code: 
Sub test()
Dim ChxAn$, fin&, Debut
ChxAn = InputBox("Saisir l'année de votre calendrier", "Calendrier", Year(Date))
With [A5] 'à adapter
  .Value = DateValue("1/1/" & ChxAn)
  fin = CLng(DateValue("31/12/" & ChxAn)) + 1462 * .Parent.Parent.Date1904
  .DataSeries 2, 3, 1, 1, fin, False
End With
End Sub
A+
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Re : Comment modifier ce code afin de générer calendrier annuel 1904 sur une colonn

Bonjour à tous


Cela fonctionne sans se préoccuper de 1904, non ?
(que ce soit avec le code d'Hoerwind ou avec ma version de celui-ci)
Code: 
Sub CAL1COL()
Dim ChxAn: ChxAn = InputBox("Année?", "calendrier", Year(Date))
[A5] = "1/1/" & ChxAn: [A5].DataSeries 2, 3, 1, 1, DateSerial(ChxAn, 12, 31), 0
End Sub

EDITION: Autant pour moi, j'avais testé mon code avec 1904 décoché
(ce qui est la valeur par défaut, non ?)
En tout cas, mon code fonctionne si case 1904 décochée.
 
Dernière édition:
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : Comment modifier ce code afin de générer calendrier annuel 1904 sur une colonn

Re,

Ceci me paraît plus impec :

Code: 
Sub test()
Dim ChxAn$
ChxAn = InputBox("Saisir l'année de votre calendrier", "Calendrier", Year(Date))
With [A5] 'à adapter
  .Value = DateValue("1/1/" & ChxAn)
  .AutoFill .Resize(366)
  If Day(.Offset(365)) = 1 Then .Offset(365) = ""
End With
End Sub
A+
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Re : Comment modifier ce code afin de générer calendrier annuel 1904 sur une colonn

Bonjour job75

Deux variantes de ton AutoFill ;)
(Parce que faut bien s'occuper les après-midi de jour férié pluvieux ;) )
Code: 
Sub testII()
Dim ChxAn, x
    ChxAn = _
    InputBox("Saisir l'année de votre calendrier", "Calendrier", Year(Date))
    Columns(1).Clear
    With [A5]
        .Value = "1/1/" & ChxAn: x = DateSerial(ChxAn, 12, 31) - .Value: .AutoFill .Resize(x + 1)
    End With
End Sub

Code: 
Sub testIII()
Dim ChxAn, x
    ChxAn = _
    InputBox("Saisir l'année de votre calendrier", "Calendrier", Year(Date))
    Columns(1).Clear
    With [A5]
        .Value = "1/1/" & ChxAn: x = CDate("31/12/" & ChxAn) - .Value: .AutoFill .Resize(x + 1)
    End With
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : Comment modifier ce code afin de générer calendrier annuel 1904 sur une colonn

Bonjour JM,

D'accord pour ta solution mais elle est plus compliquée.

Plutôt que d'effacer toute la colonne il vaut mieux toujours renseigner/effacer la 366ème cellule (A370).

A+
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Re : Comment modifier ce code afin de générer calendrier annuel 1904 sur une colonn

Re

job75
C'est parce que
(Parce que faut bien s'occuper les après-midi de jour férié pluvieux ;) )
Cliquez pour agrandir...
que je me complique la procédure.
Tu veux quand même pas que je me visse devant mon écran de TV pour oublier la grisaille ;)
PS: Mon effacement de colonne est effectivement trop dispendieux, voila j'y ai remédié ;)
Code: 
Sub testIV()
Dim ChxAn, x
    ChxAn = _
    InputBox("Saisir l'année de votre calendrier", "Calendrier", Year(Date))
    [A5:A371] = Empty
    With [A5]
        .Value = "1/1/" & ChxAn: x = CDate("31/12/" & ChxAn) - .Value: .AutoFill .Resize(x + 1)
    End With
End Sub
et une dernière avec le petit défaut qui va bien pour finir ;)
Code: 
Sub TestV()
Dim ChxAn, p As Range
[A5] = Empty
ChxAn = _
InputBox("Saisir l'année de votre calendrier", "Calendrier", Year(Date))
Set p = [A6:A370]: [A5] = "1/1/" & ChxAn: p.FormulaLocal = "=A5+1"
End Sub
(Mais avec une petite MFC* on n'y verra que du feu ;)
formule de la MCF: =ANNEE(A370)<>ANNEE($A$6)
Couleur police: blanche
*: MFC appliquée sur les cellules A370 et A371
 
Dernière édition:
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : Comment modifier ce code afin de générer calendrier annuel 1904 sur une colonn

Re,

Bah sur ce type de problème utiliser VBA c'est évidemment grotesque :cool:

Fichier joint avec cette formule en A5 tirée jusqu'à A370 :

Code: 
=SI(ESTNUM(LN(ANNEE(DATE(A$2;1;LIGNES(A$5:A5)))=A$2));DATE(A$2;1;LIGNES(A$5:A5));"")
A+
 

Pièces jointes

  • Dates(1).xls
    72.5 KB · Affichages: 49
  • Dates(1).xls
    72.5 KB · Affichages: 44
  • Dates(1).xls
    72.5 KB · Affichages: 52
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Re : Comment modifier ce code afin de générer calendrier annuel 1904 sur une colonn

Bonsoir à tous

job75
Le grotesque ne m'effraie point alors j'ose ;)
Code: 
Sub Calendrier_VersionPlusQueDispensable()
Dim PJ, DJ, i%
Dim ChxAn: ChxAn = InputBox("Année?", "calendrier", Year(Date))
[A5:A371] = Empty
PJ = CDate("1/1/" & ChxAn): DJ = CDate("31/12/" & ChxAn)
For i = 0 To (DJ - PJ)
Cells(i + 4, 1) = StrConv(Format(DateAdd("d", i, PJ), "dddd dd mmmm yyyy"), vbProperCase)
Next
End Sub
 
Vote positif 0 Vote négatif
ROGER2327

ROGER2327

XLDnaute Barbatruc
Re : Comment modifier ce code afin de générer calendrier annuel 1904 sur une colonn

Bonjour à tous.


Plus on est de fous, plus on rit.
Pas de raison que je ne m'y mêle pas !​
VB: 
Private Sub test()
    With Selection
        With [A5]
            .Value = CLng(DateSerial(InputBox("Saisir l'année du calendrier :", _
                "Calendrier type " & 1900 - 4 * .Parent.Parent.Date1904, Year(Date)), 1, 1)) + 1462 * .Parent.Parent.Date1904
            With .Parent.Parent.Parent: .ScreenUpdating = False: .EnableEvents = 0: .Calculation = -4135: End With
            .Copy: With .Offset(1).Resize(365): .PasteSpecial Paste:=xlPasteFormats: .ClearContents: End With
            .DataSeries RowCol:=2, Type:=-4132, Stop:=CLng(DateSerial(Year(.Value), 12, 31)) + 1462 * .Parent.Parent.Date1904
        End With
        .Activate
        With .Parent.Parent.Parent: .Calculation = -4105: .EnableEvents = 1: .ScreenUpdating = 1: End With
    End With
End Sub

Bonne nuit !

ℝOGER2327
#7334

Vendredi 20 Palotin 141 (Saint Ti Belot, séide - fête Suprême Quarte)
20 Floréal An CCXXII, 1,0301h - sarcloir
2014-W19-5T02:28:20Z
 

Pièces jointes

  • Un an sur une colonne.xlsm
    26.4 KB · Affichages: 57
Vote positif 0 Vote négatif
C

Christian0258

XLDnaute Accro
Re : Comment modifier ce code afin de générer calendrier annuel 1904 sur une colonn

Re, le forum, Job75, Staple1600, ROGER2327,

Je vous remercie pour vos solutions. Trois "cadors" pour cette question je suis content...et merci aussi au mauvais temps...lol

Bien à vous.
Christian
 
Vote positif 0 Vote négatif

Discussions similaires

C
  • Question
Modif code générer cal 1904...
Réponses
0
Affichages
918
Christian
C
M
[REF] Wiki 4 de MichelXld (Fonctions, Evenements, Dates et calendriers, Flash , Ooo)
Réponses
0
Affichages
34 K
MichelXld
M
C
  • Question
Code VBA Calendrier...
Réponses
1
Affichages
2 K
michel
M

Membres actuellement en ligne

5 membres et 112 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 084
Messages
2 085 192
Membres
102 809
dernier inscrit
Sandrine83