XL 2021 Création agenda

Créer une discussion
Répondre

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
Nicolas JACQUIN

Nicolas JACQUIN

XLDnaute Accro
Supporter XLD
Bonsoir tout le monde,

Sur ma création d'agenda, j'ai un petit problème avec mon code, y a un petit truc que j'arrive pas à régler.
Si le mois n'existe pas je le créer sans soucis, mais si le mois existe, ça me dis que le moi existe déjà, je dis ok mais sur ma feuille paramètre ça scroll jusqu'à la colonne "Q", il y a une tuile, je vois un peut près ou mais j'arrive pas à l'interpétrer comme il faut.

Merci à tous
Nico

test form6.gif


test form7.gif
 

Pièces jointes

Dernière édition:
Solution
Phil69970
Nicolas

Ton Pb vient d'ici

1726522227041.png

et comme je ne pense pas que l'on peut scroller une feuille non active il faudrait mémoriser le nombre de scroll de colonne

VB: 
Function Actu_jour(année, mois)
    Application.ScreenUpdating = False
    Dim i As Long, nbjour As Long
    nbjour = Day(DateSerial(année, mois + 1, 0)) ' te donne le nombre de jour dans le mois en parametre
    lig = 2: col = 3
    With Worksheets("Feuil1")
        For i = 1 To nbjour
            '.Range(.Cells(lig, col), .Cells(lig + 1, col)).Interior.ColorIndex = 24
            If année = Year(Date) And mois = Month(Date) And i = Day(Date) Then
                '.Range(.Cells(lig, col), .Cells(lig + 1, col)).Interior.ColorIndex = 28 'Coloriage aujourd'hui...
Trier par date Trier par votes
Bon, ça fait 6 à 7 message que j'essai de partager un truc trouvé et bidouiller qui serai peut-être pas mal
En module 1

VB: 
Sub CalculerAgeDansTableau()
    Dim ws As Worksheet
    Dim tbl As ListObject
    Dim i As Long
    Dim dateNaissance As Date
    Dim age As Long
    Dim ligne As ListRow

    Set ws = ThisWorkbook.Sheets("Paramètre")

    Set tbl = ws.ListObjects("t_Anniv")

    For Each ligne In tbl.ListRows

        dateNaissance = ligne.Range(1, tbl.ListColumns("Date").Index).Value

        age = DateDiff("yyyy", dateNaissance, Date)

        If Date < DateSerial(Year(Date), Month(dateNaissance), Day(dateNaissance)) Then
            age = age - 1
        End If

        ligne.Range(1, tbl.ListColumns("Âge").Index).Value = age

        If ligne.Range(1, tbl.ListColumns("Date").Index).Value = "" Then
            ligne.Range(1, tbl.ListColumns("Âge").Index).Value = ""
        End If

        If ligne.Range(1, tbl.ListColumns("Inconnu").Index).Value = "x" Then
            ligne.Range(1, tbl.ListColumns("Âge").Index).Value = ""
        End If

    Next ligne

    MsgBox "Calcul des âges terminé !"
End Sub

Capture d’écran 2024-09-23 172523.jpg


Le tout c'est d'adapter
 

Pièces jointes

Vote positif 0 Vote négatif
Nicolas JACQUIN à dit:
Comme je disais sur les autre message, les calcul se font pas, si tu as 1 an aujourd'hui, l'année prochaine tu ne peux pas avoir 1 an aussi
Cliquez pour agrandir...
OK, je comprends ce que tu veux dire.

C'est normal : les calculs de l'âge sont faux puisqu'ils sont basés sur Date au lieu d'être basés sur l'année du mois en construction. 😉
 
Dernière édition:
Vote positif 0 Vote négatif
VB: 
Function annive(Annee, Mois)
'
Dim i As Long, l As Long, lig As Long, nbjours As Long

    Application.DisplayAlerts = False
    Application.ScreenUpdating = False

    nbjours = Day(DateSerial(Annee, Mois + 1, 0)) ' Nombre de jours dans le mois passé en paramètre

    For Each fc In ActiveWorkbook.Worksheets

        With Worksheets("Paramètre")

            If fc.Name = .Range("C3") & "_" & .Range("B3") Then
                fc.Activate
                derlig = Range("A" & Rows.Count).End(xlUp).Row
                fc.Range("C" & derlig - 1 & ":AG" & derlig) = ""

                For i = 1 To nbjours

                    anniv = ""

                    With Sheets("Paramètre").ListObjects("t_Anniv")

                        For k = 1 To .ListRows.Count
                            If Month(.ListColumns("Date").DataBodyRange(k)) = Mois And Day(.ListColumns("Date").DataBodyRange(k)) = i Then
                                anniv = anniv & .ListColumns("Anniversaire").DataBodyRange(k)
                                If .ListColumns("Inconnu").DataBodyRange(k) = "x" Then
                                    anniv = anniv & "," & vbCrLf
                                Else
                                    If Annee - Year(.ListColumns("Date").DataBodyRange(k)) = 0 Then
                                        age = "(Naissance)"
                                    Else
                                        age = "(" & Annee - Year(.ListColumns("Date").DataBodyRange(k)) & " ans)"
                                    End If
                                    anniv = anniv & " " & age & "," & vbCrLf
                                End If
                            End If
                        Next k

                        If anniv <> "" Then
                            anniv = Left(anniv, Len(anniv) - 3)
                            fc.Cells(derlig - 1, i + 2) = "Anniversaire de :"
                            fc.Cells(derlig, i + 2) = vbCrLf & anniv
                            fc.Cells(derlig, i + 2).VerticalAlignment = xlTop
                        End If

                    End With

                Next i

            End If

        End With

    Next fc
    
'    Worksheets("Paramètre").Activate

End Function
 
Dernière édition:
Vote positif 0 Vote négatif
TooFatBoy à dit:
VB: 
Function annive(Annee, Mois)
'
Dim i As Long, l As Long, col As Long, lig As Long, nbjours As Long

    Application.DisplayAlerts = False
    Application.ScreenUpdating = False

    nbjours = Day(DateSerial(Annee, Mois + 1, 0)) ' Nombre de jours dans le mois passé en paramètre

    For Each fc In ActiveWorkbook.Worksheets
        With Worksheets("Paramètre")
            If fc.Name = .Range("C3") & "_" & .Range("B3") Then
                fc.Activate
                derlig = Range("A" & Rows.Count).End(xlUp).Row
                col = 3
                fc.Range("C" & derlig - 1 & ":AG" & derlig) = ""

                For i = 1 To nbjours

                    anniv = ""

                    With Sheets("Paramètre").ListObjects("t_Anniv")

                        For k = 1 To .ListRows.Count
                            If Month(.ListColumns("Date").DataBodyRange(k)) = Mois And Day(.ListColumns("Date").DataBodyRange(k)) = i Then
                                anniv = anniv & .ListColumns("Anniversaire").DataBodyRange(k)
                                If .ListColumns("Inconnu").DataBodyRange(k) = "x" Then
                                    anniv = anniv & "," & vbCrLf
                                Else
                                    If Annee - Year(.ListColumns("Date").DataBodyRange(k)) = 0 Then
                                        age = "(Naissance)"
                                    Else
                                        age = "(" & Annee - Year(.ListColumns("Date").DataBodyRange(k)) & " ans)"
                                    End If
                                    anniv = anniv & " " & age & "," & vbCrLf
                                End If
                            End If
                        Next k

                        If anniv <> "" Then
                            anniv = Left(anniv, Len(anniv) - 3)
                            fc.Cells(derlig - 1, col) = "Anniversaire de :"
                            fc.Cells(derlig, col) = vbCrLf & anniv
                            fc.Cells(derlig, col).VerticalAlignment = xlTop
                        End If

                    End With

                    col = col + 1

                Next i

            End If
        End With
    Next fc
  
'    Worksheets("Paramètre").Activate

End Function
Cliquez pour agrandir...

alléluia 😉 😉 😉

Merci Beaucoup
 
Vote positif 0 Vote négatif
Il y a toujours ta Function SemISO qui n'est pas utile et que tu peux donc supprimer pour simplifier le code global.

Tu mets simplement
VB: 
.Cells(1, 2 + i).Value = "Semaine " & Format(DateSerial(année, Mois, i), "ww", vbMonday, vbFirstFourDays)
dans ta partie "Fusion Numéro de semaine", et ça fera la même chose, mais plus simplement. 😉
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

piga25
  • Résolu(e)
XL 2016 Tableau croisé dynamique
Réponses
2
Affichages
177
piga25
piga25
S
  • Résolu(e)
XL 2013 Copier-Coller une ligne dans tableau variable, et la manipuler.
Réponses
4
Affichages
245
StéphaneDeLà
S
T
  • Question Question
Microsoft 365 Problème d'accès à des boutons ActiveX dans un classeur depuis un xlam
Réponses
10
Affichages
895
ThierryP
T
Z
  • Résolu(e)
XL 2021 Tester l'existence d'un nom d'onglet
Réponses
3
Affichages
471
jm.andryszak
J
B
  • Question Question
XL 2019 Conserver les formules qui sont enregistrées dans des cellules
Réponses
8
Affichages
352
Phil69970
Phil69970
J
  • Question Question
XL 2016 Tableau structuré avec UserForm dans classeur multipages
Réponses
2
Affichages
554
jorge1201
J
O
  • Question Question
XL 2019 Code VBA pour automatiser la programmation des rotations des ouvriers qui travaillent à temps partiel et se relaient par période de temps constante.
2 3
Réponses
35
Affichages
2 K
olivier1984
O
C
  • Question Question
XL 2013 erreur dans une formule excel Sommeprod
2
Réponses
25
Affichages
677
Cattitude
C
A
  • Question Question
XL 2021 Générer des données à partir d'une ligne spécifique jusqu'à une autre
Réponses
5
Affichages
527
gbinforme
G
Nicolas JACQUIN
  • Question Question
XL 2021 Exportation feuille msgbox yes no avec module Thisworkbook
2
Réponses
21
Affichages
2 K
Nicolas JACQUIN
Nicolas JACQUIN
B
  • Résolu(e)
XL 2019 Progress Bar et Autofill - embellissement MAcro
Réponses
2
Affichages
354
benoit.guinebretiere@free
B
A
  • Résolu(e)
XL 2021 Céer un fichier (.text) avec VBA pour enregistrer les évènements dans un journal
Réponses
4
Affichages
641
arnoldbrice19
A
S
  • Question Question
XL 2019 Calculer dimanche de pâques puis insertion du 29 février
2
Réponses
26
Affichages
786
dysorthographie
dysorthographie
Usine à gaz
  • Question Question
Autres Google agenda : jours fériés soient toujours affichés (affichage par défaut)
Réponses
1
Affichages
816
fanch55
fanch55
A
  • Question Question
XL 2016 Adapter une image à une cellule
2
Réponses
16
Affichages
2 K
Dudu2
Dudu2
T
  • Résolu(e)
XL 2019 Contrôle de saisie d'heures
Réponses
10
Affichages
550
ThierryP
T
K
  • Résolu(e)
XL 2013 Modifier noms de plage par lots
Réponses
6
Affichages
563
Kostrovit
K
L
  • Question Question
XL pour MAC tableau ans perturbation des colonnes non copié
Réponses
5
Affichages
690
DJunqueira
D
Simbaa
  • Question Question
Microsoft 365 Création d'un fichier entier par rapport à des entrées via UserForm
Réponses
1
Affichages
685
job75
job75
S
  • Question Question
Microsoft 365 Bug Me.Controls dans mon Userform
Réponses
4
Affichages
491
Jacky67
Jacky67
Retour