[MAC] Création, Suppression et Modification de la taille de caractères

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


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:

Discussions similaires

Statistiques des forums

Discussions
312 328
Messages
2 087 318
Membres
103 515
dernier inscrit
Cherbil12345