Microsoft 365 UserForm heures et minutes afficher à droite de ma cellule

Usine à gaz à dit:

Re
Suis-je t'y bête.
C'était prévu aussi :

VB:

'option de placement et position
'sous la cellule(2) ou à droite(1)
Private Const PlacementCalendrier = 1 '1 ou 2

Désolé du dérangement

Cliquez pour agrandir...

Usine à gaz à dit:

Bonjour cp4, le Forum

Le calendrier de Roland_M est super "abouti"
Dans le fichier test de ce fil, le calendrier est paramétré pour utilisation dans un cadre très précis.
- Le calendrier ne s'affiche pas (la date est mise automatiquement (le jour+7) ).
- Affichage heure et minutes pour rappel.

Voici en pièce jointe le même calendrier dans :
- utilisation libre de sortie en feuille "SuivisAppels",
- utilisation "dirigée" en feuille "SaisieRdV"

Cliquez pour agrandir...

cp4 à dit:

Bonjour @patricktoulon , @Usine à gaz ,

@Usine à gaz : Je n'ai pas parlé du calendrier de @Roland_M mais du tien. Celui où tu saisis (ou insères) des heures et des minutes.

A+

Cliquez pour agrandir...

patricktoulon à dit:

bonjour lionel
je constate que l'on utilise allègrement mes codes
même si ceux ci était a l’époque bien maladroits
et modifié encore plus maladroitement

VB:

Private Sub UserformPosSurCell(ByVal Obj As Range)
Dim SvgScr As Boolean: SvgScr = Application.ScreenUpdating
Application.ScreenUpdating = True
Dim PtoPx#, Z@, L1#, T1#, C#, R#, Vr As Range, H%, V%, I%, Ok As Boolean
With ActiveWindow.ActivePane
 PtoPx = (.PointsToScreenPixelsX(Cells.Width) - .PointsToScreenPixelsX(0)) / Cells.Width
End With
With ActiveWindow
   'exit si la cellule injecté n'est pas vible a l'ecran
   'For I = 1 To .Panes.Count
   ' If Not Intersect(.Panes(I).VisibleRange, Obj) Is Nothing Then Ok = True
   'Next
   'If Ok = False Then Beep: MsgBox " cette cellule n'est pas visible a l'ecran": Unload Me: Exit Sub
   Z = (ActiveWindow.Zoom / 100): Set Vr = .VisibleRange
   L1 = (.ActivePane.PointsToScreenPixelsX(Int(Obj.Left)) / PtoPx) * Z
   T1 = (.ActivePane.PointsToScreenPixelsY(Int(Obj.Top)) / PtoPx) * Z
   With .Panes(1).VisibleRange: C = .Cells(.Cells.Count).Column: R = .Cells(.Cells.Count).Row: End With
   If .SplitRow > 0 Then
     If Obj.Row < R + 1 And .ScrollRow > R Then T1 = ((.ActivePane.PointsToScreenPixelsY(Vr.Cells(1).Top) / PtoPx) * Z) - (Range(Obj, Cells(R, Obj.Column)).Height * Z)
   End If
   If .SplitColumn > 0 Then
     If Obj.Column < C + 1 And .ScrollColumn > C Then L1 = ((.ActivePane.PointsToScreenPixelsX(Vr.Cells(1).Left) / PtoPx) * Z) - (Range(Obj, Cells(Obj.Row, C)).Width * Z)
   End If
End With
'option de placement et position
'Horizontal=0=gauche  1=milieu 2=droite
'Vertical  =0=en haut 1=milieu 2=bas
If PlacementCalendrier = 1 Then 'droite
   H = 2: V = 0
ElseIf PlacementCalendrier = 2 Then 'dessous
   H = 0: V = 2
Else: H = 0: V = 2
End If
L1 = L1 + ((Obj.Width / 2) * Z) * H
T1 = T1 + ((Obj.Height / 2) * Z) * V
'position +test limites écran
Dim EcXY%
EcXY = 4 And Int(Val(Mid(Application.OperatingSystem, InStrRev(Application.OperatingSystem, " ") + 1))) = 6 And Int(Val(Application.Version)) < 15 '<2013
Me.Top = T1 + EcXY: Me.Left = L1 + EcXY
Application.ScreenUpdating = SvgScr
End Sub

a tu plusieurs pane dans ta feuille? -->non
est il plus facile de savoir la pane -->oui

si on reste en pixel le calcul est plus simple

le must c'est ce que j'avais trouvé ca à l'epoque

VB:

EcXY = 4 And Int(Val(Mid(Application.OperatingSystem, InStrRev(Application.OperatingSystem, " ") + 1))) = 6 And Int(Val(Application.Version)) < 15 '<2013

qui un peu plus tard c'est révélé être pas toujours juste sur 2 pc même systeme et même office
alors ca m'arrangeais bien sur 2007
mais apres j'ai vite compris que c’était pas ça
c'est bien pourça que j'ai abandonné cette piste dans mon principe
chez toi sur ton fichier la chose est simple
ici ton userform travaille sur la cellule que tu a rightcliqué c'est donc l'activecell et par conséquent l'activepane

Cliquez pour agrandir...