From: "...Pat" <mac.kay@brutele.be>
References: <3a8d2c9a$0$19308$5a62924d@news.skynet.be> <372a01c09823$54468940$b1e62ecf@tkmsftngxa04> <ecMV5CGmAHA.1944@tkmsftngp02> <3A8DB881.5352AB98@wanadoo.fr>
Subject: Re: Annotations et couleur de cellule (Excel 97)
Date: Sat, 17 Feb 2001 20:06:22 +0100
Lines: 141
X-Priority: 3
X-MSMail-Priority: Normal
X-Newsreader: Microsoft Outlook Express 5.00.2615.200
X-MimeOLE: Produced By Microsoft MimeOLE V5.00.2615.200
Message-ID: <OP70VyRmAHA.920@tkmsftngp02>
Newsgroups: microsoft.public.fr.excel
NNTP-Posting-Host: 212.68.227.3
Path: tkmsftngp01!tkmsftngp02
Xref: tkmsftngp01 microsoft.public.fr.excel:71022

Avec plaisir Fred !!!

Elle est d'un certain "stratos" sur MPEP
'------------------------------------------------------------------
 Sub test_fncCreateCommentIndicator()
     fncCreateCommentIndicator vbBlue, "pat"
 End Sub
'------------------------------------------------------------------
 Sub test_fncCreateCommentIndicator()
     fncCreateCommentIndicator vbBlue, "test"
 End Sub

 Option Explicit


 Public Function fncCreateCommentIndicator(CommentIndicatorColor As Long, _
 CommentIndicatorName As String) As Boolean
 'covers the comment indicators in the activeworkbook with a similar
 'triangle of the specified color, based on the Application.UserName
property
   Dim IDnumber As Long
   Dim aCell As Range
   Dim aComment As Comment
   Dim aShape As Shape
   Dim aWorksheet As Worksheet
   Dim aWorkbook As Workbook
   fncCreateCommentIndicator = False
  'check whether a code name has been entered
   If CommentIndicatorName = vbNullString Then GoTo ExitFunction
   On Error GoTo ExitFunction
   set aWorkbook = ActiveWorkbook
   IDnumber = 0
  'loop through all wprksheets in the active workbook and all comments in
each worksheet
  'and create the comment shapes
   For Each aWorksheet In aWorkbook.Worksheets
       For Each aShape In aWorksheet.Shapes
           If Left(aShape.Name, Len(CommentIndicatorName)) =
CommentIndicatorName Then
              aShape.Delete
           End If
       Next aShape
       For Each aComment In aWorksheet.Comments
           set aCell = aComment.Parent
            If InStr(1, aComment.Shape.TextFrame.Characters.Text, ":") > 0
Then
               If Left(aComment.Shape.TextFrame.Characters.Text, InStr(1,
aComment.Shape.TextFrame.Characters.Text, ":") - 1) = Application.UserName
Then
                  GoSub CreateCommentIndicator
               End If
            End If
       Next aComment
   Next aWorksheet
   fncCreateCommentIndicator = True
ExitFunction:
   On Error GoTo 0
   set aCell = Nothing
   set aComment = Nothing
   set aShape = Nothing
   set aWorksheet = Nothing
   set aWorkbook = Nothing
   Exit Function
CreateCommentIndicator:
   set aShape = aWorksheet.Shapes.AddShape(Type:=msoShapeRightTriangle, _
   Left:=aCell.Left + aCell.Width - 5, _
   Top:=aCell.Top, _
   Width:=5, _
   Height:=5)
   IDnumber = IDnumber + 1
   With aShape
      .Name = CommentIndicatorName & CStr(IDnumber)
      .IncrementRotation -180#
      .Fill.Visible = msoTrue
      .Fill.Solid
      .Fill.ForeColor.RGB = CommentIndicatorColor
      .Line.Visible = msoTrue
      .Line.Weight = 1
      .Line.Style = msoLineSingle
      .Line.DashStyle = msoLineSolid
      .Line.ForeColor.RGB = CommentIndicatorColor
      .Placement = xlMove
   End With
   Return
 End Function
' -------------------------------------------------
' As it is now it will colour only the comments that keep the default name
' given by excel (Application.username)

' HTH
' Stratos




Fr&eacute;d&eacute;ric Sigonneau <frederic.sigonneau@wanadoo.fr> a &eacute;crit dans le message :
3A8DB881.5352AB98@wanadoo.fr...
> Eh Pat,
>
> Tu ne pourrais pas nous recopier ça ?
>
> FS
>
> "...Pat" a &eacute;crit :
> >
> > Il parait que l'on peut changer la couleur du triangle aussi, j'ai
charg&eacute;
> > mais pas test&eacute; sur mpep.
> >
> > Pat
> >
> > Yannick <kaym2@caramail.com> a &eacute;crit dans le message :
> > 372a01c09823$54468940$b1e62ecf@tkmsftngxa04...
> >
> > Salut Jean-Marie,
> > si j'ai bien compri, tu veux savoir s'il est possible de mettre un fond
de
> > couleur alors que ta cellule comprend deja une annotation ou un
> > commentaire...
> >
> > Ben si c'est ca ton "probleme", en effet tu peux le faire en changeant
comme
> > tu
> > le ferai autrement la couleur du fond de ta cellule (barre d'outil mise
en
> > forme,
> > le p'tit pot de peinture) et voila!
> > Tu obtiens une cellule avec ton commentaire et un fond de la couleur que
tu
> > aura
> > choisi...
> >
> > :)
>
> --
> Fr&eacute;d&eacute;ric Sigonneau [n&eacute; un Sans-culottide !]
> Gestions de temps : http://perso.wanadoo.fr/frederic.sigonneau
>
>