Microsoft 365 Calendrier dans cellule

[Scorpio]

Bonjour,
J'aimerais utiliser c calendrier dans ce classeur, dans la colonne B, a partir de B2, mais je ne suis pas un expert en code, alors je m'adresse
a vous pour me donner un coup de pouce, s'il vous plaît
Est-ce possible, et merci d'avance
Scorpio

 

[Todre]

Merci pour le retour rapide, par contre je comprend pas ta réponse, désolé

J'ai regardé dans mon fichier, mis un autre code mais je ne vois pas de noms ou autres, je ne trouve pas où il faut renseigner les cellules concernées ?

 

[Dranreb]

C'est dans VBE que ça se passe. Il faut ouvrir un des classeur possédant l'UserForm qui vous intéresse et glisser/déplacer son nom depuis son projet vers celui de votre classeur.

 

[Todre]

Tu m'a perdu je crois je vais opter pour un remplissage à la mano si c'est trop compliqué à mettre en oeuvre

 

[Dranreb]

Ce n'est pas compliqué du tout. Qu'est-ce que vous ne comprenez pas ?

 

[Todre]

Ce n'est pas compliqué du tout. Qu'est-ce que vous ne comprenez pas ?

Le UserForm et le glisser déposer, le code que j'ai mis dans mon classeur n'est pas bon du tout ?

 

[Dranreb]

Pour le calendrier de patricktoulon peut être, encore qu'il ne contient pas d'instruction pour en limiter l'effet à la plage B12:C19. Pour celui des miens qui est avec les numéros de semaines par exemple ce serait plutôt :

Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   If Target.CountLarge > 1 Or Intersect(Me.[B12:C19], Target) Is Nothing Then Exit Sub
   UFmCalenS.Posit Target, 0, 1
   Target.Value = UFmCalenS.Saisie(Titre:=IIf(Target.Column = 2, "Début", "Fin"), _
      DInit:=Target.Value, Défaut:=Target.Value)
   End Sub

Ce qui manque surtout c'est la manœuvre d'installation de l'UserForm par glisser/déplacer dans l'explorateur de projets depuis le projet source vers le projet cible

 

[patricktoulon]

bonjour
le voici avec le simply 7.5

et pour @Dranreb(si ça l’intéresse)vu que nous avons travailler pallement avec 3 méthodes différente toi Roland et moi sur ce projet
ci joint le fonction qui remplace ma fonction( placementrange) de 2019
je l'ai aussi intégré a cette version de calendrier

le code en est grandement simplifié

'************************************************************************************************************************************
Public Function GetPointDistanceCellFromTheBorderScreen(Optional Cell As Range = Nothing, Optional IndexPane& = 0)
' collection  Fonctions avec PointsToScrenPixels(X Y) / Activewindow / Activepane / panes(1 to 4) / visiblerange etc...
' récupérer la distance (des bords de l’écran a la cellule désignée)en points théoriques en incluant la gestion du freezepane et multi panne etc....
' version 2.0
' date février 2022
' auteur :patricktoulon
' Code  simplifié
' renvoie un array(1 to 2)(Left,top) ou vide
    Dim PtsToPxX#, PtsToPxy#, TheZoom#, PosXY(1 To 2), PaN As Pane, Eq As Boolean, Addr$, ip&, I&
    With ActiveWindow
        If Cell Is Nothing Then Set Cell = ActiveCell
        Eq = IndexPane > 0: Addr = Cell.Address(0, 0): ip = IndexPane
        If IndexPane > .Panes.Count Or IndexPane = 0 Then Set PaN = .ActivePane: IndexPane = .ActivePane.Index Else: Set PaN = .Panes(IndexPane)
        If .FreezePanes = True Then
            For I = 1 To .Panes.Count
                If Not Intersect(Cell, .Panes(I).VisibleRange) Is Nothing Then Set PaN = .Panes(I)
            Next
        End If
        If Eq = True And Intersect(Cell, .Panes(IndexPane).VisibleRange) Is Nothing Then MsgBox Addr & " n'est pas VISIBLE!!! dans la pane " & ip: Exit Function
        PtsToPxX = ((.Panes(1).PointsToScreenPixelsX(72) - .Panes(1).PointsToScreenPixelsX(0)) / 72)
        PtsToPxy = ((.Panes(1).PointsToScreenPixelsY(96) - .Panes(1).PointsToScreenPixelsY(0)) / 96)
        TheZoom = .Zoom / 100
        PosXY(1) = ((PaN.PointsToScreenPixelsX(Int(Cell.Left)) / PtsToPxX) * TheZoom) + (Cell.Width * TheZoom) 'left en point
        PosXY(2) = ((PaN.PointsToScreenPixelsY(Int(Cell.Top)) / PtsToPxy) * TheZoom) - IIf(Not .FreezePanes, 1, 0)    'top en point
    End With
    GetPointDistanceCellFromTheBorderScreen = PosXY
End Function
'************************************************************************************************************************************

 

[Todre]

Bonjour,

Merci les gars vous êtes top, de vrais crack d'excel