XL 2021 Création agenda

Nicolas JACQUIN · 16 Septembre 2024

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

Phil69970 · 17 Septembre 2024

Nicolas

Ton Pb vient d'ici

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...

TooFatBoy · 23 Septembre 2024

Phil69970 à dit:
J'ai pas compris ce que tu as fait et ou tu l'as fait

Il semblerait que "09-24" ne veuille pas dire "du 9 au 24" comme c'est écrit, mais "septembre 2024".

Nicolas JACQUIN · 23 Septembre 2024

Phil69970 à dit:
Nicolas
J'ai pas compris ce que tu as fait et ou tu l'as fait

Essai de faire calendrier septembre 2025 juste

TooFatBoy · 23 Septembre 2024

Nicolas JACQUIN à dit:
Ca marche (Propre) mais ça ne calcul toujours pas d'une année sur l'autre

C'est-à-dire ??? Que faut-il calculer ?

Nicolas JACQUIN · 23 Septembre 2024

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

Le tout c'est d'adapter

Nicolas JACQUIN · 23 Septembre 2024

TooFatBoy à dit:
C'est-à-dire ??? Que faut-il calculer ?

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

TooFatBoy · 23 Septembre 2024

Nicolas JACQUIN à dit:
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

C'est quoi .Index ??? Est-ce le numéro de la ligne du TS ?

TooFatBoy · 23 Septembre 2024

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

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.

Nicolas JACQUIN · 23 Septembre 2024

TooFatBoy à dit:
OK, je comprends ce que tu veux dire.

C'est normal : les calculs de l'âge sont faux puisqu'ils sont basé sur Date au lieu d'être basés sur l'année du mois en construction.

Oui c'est ça, j'ai mi un petit moment quand même

TooFatBoy · 23 Septembre 2024

Nicolas JACQUIN à dit:
Oui c'est ça, j'ai mi un petit moment quand même

Le principal est que tu aies trouvé et que maintenant ça fonctionne.

Nicolas JACQUIN · 23 Septembre 2024

TooFatBoy à dit:
Le principal est que tu aies trouvé et que maintenant ça fonctionne.

j'ai mi un petit moment à comprendre ce que tu voulais dire, mais les calculs se font toujours pas

TooFatBoy · 23 Septembre 2024

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

Nicolas JACQUIN · 23 Septembre 2024

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

alléluia

Merci Beaucoup

TooFatBoy · 23 Septembre 2024

Nicolas JACQUIN à dit:
alléluia

Merci Beaucoup

J'ai modifié la macro. Tu peux revérifier du coup ?

TooFatBoy · 23 Septembre 2024

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.

Nicolas JACQUIN · 23 Septembre 2024

TooFatBoy à dit:
J'ai modifié la macro. Tu peux revérifier du coup ?

Je ne sais pas ce que tu as refais, mais c'est tout good.
Merci de ta patience malgré ma mauvaise compréhension

XL 2021 Création agenda

Nicolas JACQUIN

XLDnaute Impliqué

Pièces jointes

Phil69970

TooFatBoy

XLDnaute Barbatruc

Nicolas JACQUIN

XLDnaute Impliqué

TooFatBoy

XLDnaute Barbatruc

Nicolas JACQUIN

XLDnaute Impliqué

Pièces jointes

Nicolas JACQUIN

XLDnaute Impliqué

TooFatBoy

XLDnaute Barbatruc

TooFatBoy

XLDnaute Barbatruc

Nicolas JACQUIN

XLDnaute Impliqué

TooFatBoy

XLDnaute Barbatruc

Nicolas JACQUIN

XLDnaute Impliqué

TooFatBoy

XLDnaute Barbatruc

Nicolas JACQUIN

XLDnaute Impliqué

TooFatBoy

XLDnaute Barbatruc

TooFatBoy

XLDnaute Barbatruc

Nicolas JACQUIN

XLDnaute Impliqué

Discussions similaires