JeanMarie
XLDnaute Barbatruc
Sur PC, pour modifier la taille de la police de caractères,
il y a cette instruction (donné par Michel)
Range("A1").Comment.Shape.!OLEFormat.Object.Font.Size = 14 ' taille texte
Mais cette ligne de commande ne fonctionne pas sur plate-forme Mac
dû au non portage des OLEFormat.
Il faut passé par ces deux lignes de commandes (idem à la version 97)
ActiveCell.Comment.Shape.Select
Selection.Font.Size = 14
il y a cette instruction (donné par Michel)
Range("A1").Comment.Shape.!OLEFormat.Object.Font.Size = 14 ' taille texte
Mais cette ligne de commande ne fonctionne pas sur plate-forme Mac
dû au non portage des OLEFormat.
Il faut passé par ces deux lignes de commandes (idem à la version 97)
ActiveCell.Comment.Shape.Select
Selection.Font.Size = 14
Code:
Private Sub !Worksheet_SelectionChange(ByVal Target As Range)
Dim I As Byte ' valeur de boucle
Dim vComment As String 'contient le texte du commentaire qui sera affiché
'Efface le commentaire, initialisation des variables
If vAdress <> "" Then
Range(vAdress).ClearComments
vAdress = ""
vComment = ""
Application.OnTime EarliestTime:=VNow, Procedure:="ChronoComment", Schedule:=False
End If
'Test de la position de la cellule active
If Application.Intersect(Target, Range("B7:B500")) Is Nothing Then: Exit Sub
'Test de la présence du cheval dans la base
Range("N1") = ActiveCell
'Le calcul de la position a été demandé dans la feuille en position N2
If Range("N2") = "" Then: Exit Sub
'le chaval est dans la base, affichage du commentaire
'Mise en forme du commentaire par rapport au données de la base
For I = 1 To Worksheets("Base").Range("IV3").End(xlToLeft).Column 'suivant le nombre de colonnes dans la base
vComment = vComment & vbLf & Worksheets("Base").Cells(3, I) & " : " & Worksheets("Base").Cells(Range("N2"), I)
Next I
vComment = Mid(vComment, 2, Len(vComment)) 'Efface le premier retour à la ligne
vAdress = ActiveCell.Address 'sauvegarde de l'adresse de la cellule
ActiveCell.AddComment 'ajoute un commentaire
With ActiveCell.Comment
.Text Text:=vComment 'inscrit le commentaire
.Shape.ScaleWidth 2, msoFalse, msoScaleFromTopLeft 'Modifie la largeur
.Shape.ScaleHeight 13, msoFalse, msoScaleFromTopLeft 'Modifie la hauteur
End With
ActiveCell.Comment.Shape.Select
Selection.Font.Size = 14
'Lancemant du compte à rebours pour effacement automatique
VNow = Now + TimeValue("00:00:03") 'Intervalle d'affichage est de 3 secondes
'Il faut passer par une variable pour permettre l'arrêt
Application.OnTime VNow, "ChronoComment"%%
fin de procédure
End Sub
Dernière édition: