XL 2016 Commentaire au survol de la souris

Mimi

XLDnaute Occasionnel
Bonjour à tous,
Dans ce classeur il y a une feuille accueil et une Base. Dans la feuille base je rempli mes événements qui se mette en orange sur le calendrier de la feuille accueil, jusque là tout va bien.
Ce que je recherche c'est en cliquant sur n'importe quel case orange de la feuille accueil il m'affiche ce qu'il y a le jour en rapport avec ce que j'ai rempli dans ma base.
D'avance merci
Mimi
 

Pièces jointes

  • Classeur1 (2).xlsm
    76.3 KB · Affichages: 3

BOISGONTIER

XLDnaute Barbatruc
Repose en paix
Bonjour,


VB:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Set f = Sheets("base")
  If Not Intersect(Range("C9:I13"), Target) Is Nothing Then
    dte = Target
    Set result = f.[C:C].Find(what:=dte)
    If Not result Is Nothing Then
      MsgBox Format(result.Offset(, 1), "hh:mm") & vbLf _
      & result.Offset(, 2) & vbLf & result.Offset(, 4)
    End If
  End If 
End Sub

Boisgontier
 

Pièces jointes

  • Copie de Classeur1 (2).xlsm
    83.5 KB · Affichages: 9

BOISGONTIER

XLDnaute Barbatruc
Repose en paix
version survol:

VB:
Private Sub Worksheet_Activate()
   Cmt
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Range("A1"), Target) Is Nothing Then
    Cmt
  End If
End Sub

Sub Cmt()
  Set f1 = Sheets("Accueil")
  Set f2 = Sheets("base")
  Set rng1 = f1.Range("C9:I14")
  On Error Resume Next
  rng1.ClearComments
  On Error GoTo 0
  Set Rng2 = f2.Range("C2:C" & f2.[C65000].End(xlUp).Row)
  For Each c In Rng2
    If Month(c) = f1.[A1] Then
      Set result = rng1.Find(what:=Day(c.Value), LookIn:=xlValues)
      If Not result Is Nothing Then
      With result
        .AddComment ' Création commentaire
        .Comment.Shape.OLEFormat.Object.Font.Name = "Tverdana"
        .Comment.Shape.OLEFormat.Object.Font.Size = 7
        .Comment.Shape.OLEFormat.Object.Font.FontStyle = "Normal"
        .Comment.Text Text:=Format(c.Offset(, 1), "hh:mm") & vbLf & c.Offset(, 2) & vbLf & c.Offset(, 4)
        .Comment.Shape.TextFrame.AutoSize = True
      End With
    End If
   End If
  Next c
End Sub

Autres exemples:

Boisgontier
 

Pièces jointes

  • survol.xlsm
    88.6 KB · Affichages: 13
Dernière édition:

Discussions similaires

Réponses
8
Affichages
444
Réponses
7
Affichages
327

Membres actuellement en ligne

Aucun membre en ligne actuellement.

Statistiques des forums

Discussions
312 105
Messages
2 085 350
Membres
102 870
dernier inscrit
Armisa