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 🙂