modifier apparence d'un "Shape"

Le
j-pascal
Bonjour,

L'auteur du code suivant se reconnaitra ;-)

Comment puis-je modifier certains paramètres du "Shape" ?

Shapes("monshape").Visible = True
If Err <> 0 Then CreeShape: Target.Select

Shapes("monshape").Left = ActiveCell.Left
Shapes("monshape").Top = ActiveCell.Top + ActiveCell.Height + 3
Shapes("monshape").TextFrame.Characters.Text = "suppr. interdite"

1 - J'ai trouvé ça pour mettre la police en blanc sur fond rouge

Shapes("monshape").OLEFormat.Object.Font.ColorIndex = 2
Shapes("monshape").OLEFormat.Object.Interior.ColorIndex = 3

2 - L'ajustement du texte à la taille automatique ne fonctionne pas ! Je
dois augmenter le texte !

Shapes("monshape").Selection.AutoSize = True

3 - Le reste du code est là :

Sub CreeShape()

Shapes.AddTextbox(msoTextOrientationHorizontal, 1, 1, 50, 10).Select
Selection.Font.Name = "Verdana"
Selection.Font.Size = 7
Selection.Name = "monshape"
Shapes("monshape").Left = ActiveCell.Left
Shapes("monshape").Top = ActiveCell.Top + ActiveCell.Height + 3
'Shapes("monshape").Selection.AutoSize = True

End Sub

J'ai du mal à différencier les paramètres du Shape en fonction du code
ci-dessus et celui du haut du présent message

Merci pour vos lumières ;-)

PS : pour résumer, je souhaite augmenter la longueur du texte, le mettre en
gras, en blanc sur fond rouge, et dans un cadre de la bonne taille !

--
Cordialement @+
JP
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
JB
Le #4814851
Bonjour,

Longueur:70
Hauteur:10
Couleur fond:10

Sub creeShape()
Shapes.AddTextbox(msoTextOrientationHorizontal, 1, 1, 70, 10).Select
Selection.Name = "monshape"
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 10
Selection.Font.Name = "Verdana"
Selection.Font.Size = 8
Selection.Font.ColorIndex = 2
Selection.Font.Bold = True
Shapes("monshape").Left = ActiveCell.Left
Shapes("monshape").Top = ActiveCell.Top + ActiveCell.Height + 3
End Sub

http://cjoint.com/?hFibqEDUoj

JB

On 30 juil, 23:51, "j-pascal"
Bonjour,

L'auteur du code suivant se reconnaitra ;-)

Comment puis-je modifier certains paramètres du "Shape" ?

Shapes("monshape").Visible = True
If Err <> 0 Then CreeShape: Target.Select

Shapes("monshape").Left = ActiveCell.Left
Shapes("monshape").Top = ActiveCell.Top + ActiveCell.Height + 3
Shapes("monshape").TextFrame.Characters.Text = "suppr. interdi te"

1 - J'ai trouvé ça pour mettre la police en blanc sur fond rouge ...

Shapes("monshape").OLEFormat.Object.Font.ColorIndex = 2
Shapes("monshape").OLEFormat.Object.Interior.ColorIndex = 3

2 - L'ajustement du texte à la taille automatique ne fonctionne pas ! Je
dois augmenter le texte !

Shapes("monshape").Selection.AutoSize = True

3 - Le reste du code est là :

Sub CreeShape()

Shapes.AddTextbox(msoTextOrientationHorizontal, 1, 1, 50, 10).Select
Selection.Font.Name = "Verdana"
Selection.Font.Size = 7
Selection.Name = "monshape"
Shapes("monshape").Left = ActiveCell.Left
Shapes("monshape").Top = ActiveCell.Top + ActiveCell.Height + 3
'Shapes("monshape").Selection.AutoSize = True

End Sub

J'ai du mal à différencier les paramètres du Shape en fonction du c ode
ci-dessus et celui du haut du présent message ...

Merci pour vos lumières ;-)

PS : pour résumer, je souhaite augmenter la longueur du texte, le mettr e en
gras, en blanc sur fond rouge, et dans un cadre de la bonne taille !

--
Cordialement @+
JP


JB
Le #4814841
Ajustement auto:

Shapes("monshape").OLEFormat.Object.AutoSize = True

Modif couleur fond:


Shapes("monshape").OLEFormat.Object.ShapeRange.Fill.ForeColor.SchemeColor
= 21

JB

On 31 juil, 08:01, JB
Bonjour,

Longueur:70
Hauteur:10
Couleur fond:10

Sub creeShape()
Shapes.AddTextbox(msoTextOrientationHorizontal, 1, 1, 70, 10).Select
Selection.Name = "monshape"
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 10
Selection.Font.Name = "Verdana"
Selection.Font.Size = 8
Selection.Font.ColorIndex = 2
Selection.Font.Bold = True
Shapes("monshape").Left = ActiveCell.Left
Shapes("monshape").Top = ActiveCell.Top + ActiveCell.Height + 3
End Sub

http://cjoint.com/?hFibqEDUoj

JB

On 30 juil, 23:51, "j-pascal"


Bonjour,

L'auteur du code suivant se reconnaitra ;-)

Comment puis-je modifier certains paramètres du "Shape" ?

Shapes("monshape").Visible = True
If Err <> 0 Then CreeShape: Target.Select

Shapes("monshape").Left = ActiveCell.Left
Shapes("monshape").Top = ActiveCell.Top + ActiveCell.Height + 3
Shapes("monshape").TextFrame.Characters.Text = "suppr. inter dite"

1 - J'ai trouvé ça pour mettre la police en blanc sur fond rouge ...

Shapes("monshape").OLEFormat.Object.Font.ColorIndex = 2
Shapes("monshape").OLEFormat.Object.Interior.ColorIndex = 3

2 - L'ajustement du texte à la taille automatique ne fonctionne pas ! Je
dois augmenter le texte !

Shapes("monshape").Selection.AutoSize = True

3 - Le reste du code est là :

Sub CreeShape()

Shapes.AddTextbox(msoTextOrientationHorizontal, 1, 1, 50, 10).Select
Selection.Font.Name = "Verdana"
Selection.Font.Size = 7
Selection.Name = "monshape"
Shapes("monshape").Left = ActiveCell.Left
Shapes("monshape").Top = ActiveCell.Top + ActiveCell.Height + 3
'Shapes("monshape").Selection.AutoSize = True

End Sub

J'ai du mal à différencier les paramètres du Shape en fonction du code
ci-dessus et celui du haut du présent message ...

Merci pour vos lumières ;-)

PS : pour résumer, je souhaite augmenter la longueur du texte, le met tre en
gras, en blanc sur fond rouge, et dans un cadre de la bonne taille !

--
Cordialement @+
JP- Masquer le texte des messages précédents -


- Afficher le texte des messages précédents -



j-pascal
Le #4814711
Bonjour JB,

Merci pour le fichier joint. J'apprécie bcp le résumé du code dans une
"image".

Dans mon classeur, ça ne marche (apparemment !) que si j'ajuste aussi le
code du "Worksheet_SelectionChange", comme ceci :

--------------------------------------------------------
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Not Intersect(Target, [MoisInterdit]) Is Nothing And Target.Count = 1
Then 'modif du 30/07/07
ActiveWorkbook.Names.Add Name:="mémo", RefersToR1C1:="=" & Chr(34) &
Target.Value & Chr(34)

compteur = 0
For Each com In Range("p" & Target.Row & ":at" & Target.Row)
If Len(com.NoteText) Then compteur = 1: Exit For
Next
If Application.Sum(Range("f" & Target.Row & ":" & "m" &
Target.Row)) > 0 Or compteur = 1 Then

On Error Resume Next

Shapes("monshape").Visible = True
If Err <> 0 Then creeShape: Target.Select

Shapes("monshape").Left = ActiveCell.Left
Shapes("monshape").Top = ActiveCell.Top + ActiveCell.Height + 3
Shapes("monshape").TextFrame.Characters.Text = "suppression
interdite !"

Shapes("monshape").OLEFormat.Object.AutoSize = True
Shapes("monshape").OLEFormat.Object.ShapeRange.Fill.ForeColor.SchemeColor
= 2

Shapes("monshape").OLEFormat.Object.Font.Name = "Verdana"
Shapes("monshape").OLEFormat.Object.Font.Size = 8
Shapes("monshape").OLEFormat.Object.ColorIndex = 2
Shapes("monshape").OLEFormat.Object.Font.Bold = True

Else

On Error Resume Next

Shapes("monshape").Visible = False
End If
End If 'modif du 30/07/07
End Sub
------------------------------------------------------------------------------

Je me suis rendu compte que les formes : "Selection.etc" n'avait
(apparemment) pas d'effet.
Seules fonctionnent les formes : "Shapes("monshape").OLEFormat.Object.etc"

J'ai fait plein d'ajustement, et pour finir, je me suis rendu compte (!!!)
que si je garde le code ci-dessus (Private Sub Worksheet_SelectionChange) et
que j'enlève TOUT le code compris entre "Sub creeShape()" et "End Sub", tout
semble fonctionner très bien !

Je suis un peu désolé d'avoir "massacré" le code que tu viens de me donner
et il est fort possible qu'un truc m'ait échappé ...

Fallait-il modifier le code de "Private Sub Worksheet_SelectionChange" ?

@+ ?

JP


"JB"
Ajustement auto:

Shapes("monshape").OLEFormat.Object.AutoSize = True

Modif couleur fond:


Shapes("monshape").OLEFormat.Object.ShapeRange.Fill.ForeColor.SchemeColor
= 21

JB

On 31 juil, 08:01, JB
Bonjour,

Longueur:70
Hauteur:10
Couleur fond:10

Sub creeShape()
Shapes.AddTextbox(msoTextOrientationHorizontal, 1, 1, 70, 10).Select
Selection.Name = "monshape"
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 10
Selection.Font.Name = "Verdana"
Selection.Font.Size = 8
Selection.Font.ColorIndex = 2
Selection.Font.Bold = True
Shapes("monshape").Left = ActiveCell.Left
Shapes("monshape").Top = ActiveCell.Top + ActiveCell.Height + 3
End Sub

http://cjoint.com/?hFibqEDUoj

JB

On 30 juil, 23:51, "j-pascal"


Bonjour,

L'auteur du code suivant se reconnaitra ;-)

Comment puis-je modifier certains paramètres du "Shape" ?

Shapes("monshape").Visible = True
If Err <> 0 Then CreeShape: Target.Select

Shapes("monshape").Left = ActiveCell.Left
Shapes("monshape").Top = ActiveCell.Top + ActiveCell.Height + 3
Shapes("monshape").TextFrame.Characters.Text = "suppr.
interdite"

1 - J'ai trouvé ça pour mettre la police en blanc sur fond rouge ...

Shapes("monshape").OLEFormat.Object.Font.ColorIndex = 2
Shapes("monshape").OLEFormat.Object.Interior.ColorIndex = 3

2 - L'ajustement du texte à la taille automatique ne fonctionne pas ! Je
dois augmenter le texte !

Shapes("monshape").Selection.AutoSize = True

3 - Le reste du code est là :

Sub CreeShape()

Shapes.AddTextbox(msoTextOrientationHorizontal, 1, 1, 50, 10).Select
Selection.Font.Name = "Verdana"
Selection.Font.Size = 7
Selection.Name = "monshape"
Shapes("monshape").Left = ActiveCell.Left
Shapes("monshape").Top = ActiveCell.Top + ActiveCell.Height + 3
'Shapes("monshape").Selection.AutoSize = True

End Sub

J'ai du mal à différencier les paramètres du Shape en fonction du code
ci-dessus et celui du haut du présent message ...

Merci pour vos lumières ;-)

PS : pour résumer, je souhaite augmenter la longueur du texte, le mettre
en
gras, en blanc sur fond rouge, et dans un cadre de la bonne taille !

--
Cordialement @+
JP- Masquer le texte des messages précédents -


- Afficher le texte des messages précédents -



JB
Le #4814701
-La procédure CreeShape() crée le shape MonShape si celui a été
supprimé.
-Selection... n'a de sens que si l'on a sélectionné le shape avec
Shapes("Monshape").Select

JB


On 31 juil, 09:43, "j-pascal"
Bonjour JB,

Merci pour le fichier joint. J'apprécie bcp le résumé du code dans une
"image".

Dans mon classeur, ça ne marche (apparemment !) que si j'ajuste aussi le
code du "Worksheet_SelectionChange", comme ceci :

--------------------------------------------------------
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Not Intersect(Target, [MoisInterdit]) Is Nothing And Target.Count = 1
Then 'modif du 30/07/07
ActiveWorkbook.Names.Add Name:="mémo", RefersToR1C1:="=" & Ch r(34) &
Target.Value & Chr(34)

compteur = 0
For Each com In Range("p" & Target.Row & ":at" & Target.Row)
If Len(com.NoteText) Then compteur = 1: Exit For
Next
If Application.Sum(Range("f" & Target.Row & ":" & "m" &
Target.Row)) > 0 Or compteur = 1 Then

On Error Resume Next

Shapes("monshape").Visible = True
If Err <> 0 Then creeShape: Target.Select

Shapes("monshape").Left = ActiveCell.Left
Shapes("monshape").Top = ActiveCell.Top + ActiveCell.Height + 3
Shapes("monshape").TextFrame.Characters.Text = "suppression
interdite !"

Shapes("monshape").OLEFormat.Object.AutoSize = True
Shapes("monshape").OLEFormat.Object.ShapeRange.Fill.ForeColor.Sch emeColor
= 2

Shapes("monshape").OLEFormat.Object.Font.Name = "Verdana"
Shapes("monshape").OLEFormat.Object.Font.Size = 8
Shapes("monshape").OLEFormat.Object.ColorIndex = 2
Shapes("monshape").OLEFormat.Object.Font.Bold = True

Else

On Error Resume Next

Shapes("monshape").Visible = False
End If
End If 'modif du 30/07/07
End Sub
------------------------------------------------------------------------- --­---

Je me suis rendu compte que les formes : "Selection.etc" n'avait
(apparemment) pas d'effet.
Seules fonctionnent les formes : "Shapes("monshape").OLEFormat.Object.etc"

J'ai fait plein d'ajustement, et pour finir, je me suis rendu compte (!!!)
que si je garde le code ci-dessus (Private Sub Worksheet_SelectionChange) et
que j'enlève TOUT le code compris entre "Sub creeShape()" et "End Sub", tout
semble fonctionner très bien !

Je suis un peu désolé d'avoir "massacré" le code que tu viens de me donner
et il est fort possible qu'un truc m'ait échappé ...

Fallait-il modifier le code de "Private Sub Worksheet_SelectionChange" ?

@+ ?

JP

"JB"
Ajustement auto:

Shapes("monshape").OLEFormat.Object.AutoSize = True

Modif couleur fond:

Shapes("monshape").OLEFormat.Object.ShapeRange.Fill.ForeColor.SchemeColor
= 21

JB

On 31 juil, 08:01, JB


Bonjour,

Longueur:70
Hauteur:10
Couleur fond:10

Sub creeShape()
Shapes.AddTextbox(msoTextOrientationHorizontal, 1, 1, 70, 10).Select
Selection.Name = "monshape"
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 10
Selection.Font.Name = "Verdana"
Selection.Font.Size = 8
Selection.Font.ColorIndex = 2
Selection.Font.Bold = True
Shapes("monshape").Left = ActiveCell.Left
Shapes("monshape").Top = ActiveCell.Top + ActiveCell.Height + 3
End Sub

http://cjoint.com/?hFibqEDUoj

JB

On 30 juil, 23:51, "j-pascal"
Bonjour,

L'auteur du code suivant se reconnaitra ;-)

Comment puis-je modifier certains paramètres du "Shape" ?

Shapes("monshape").Visible = True
If Err <> 0 Then CreeShape: Target.Select

Shapes("monshape").Left = ActiveCell.Left
Shapes("monshape").Top = ActiveCell.Top + ActiveCell.Heigh t + 3
Shapes("monshape").TextFrame.Characters.Text = "suppr.
interdite"

1 - J'ai trouvé ça pour mettre la police en blanc sur fond rouge ...

Shapes("monshape").OLEFormat.Object.Font.ColorIndex = 2
Shapes("monshape").OLEFormat.Object.Interior.ColorIndex = 3

2 - L'ajustement du texte à la taille automatique ne fonctionne pas ! Je
dois augmenter le texte !

Shapes("monshape").Selection.AutoSize = True

3 - Le reste du code est là :

Sub CreeShape()

Shapes.AddTextbox(msoTextOrientationHorizontal, 1, 1, 50, 10).Select
Selection.Font.Name = "Verdana"
Selection.Font.Size = 7
Selection.Name = "monshape"
Shapes("monshape").Left = ActiveCell.Left
Shapes("monshape").Top = ActiveCell.Top + ActiveCell.Height + 3
'Shapes("monshape").Selection.AutoSize = True

End Sub

J'ai du mal à différencier les paramètres du Shape en fonction du code
ci-dessus et celui du haut du présent message ...

Merci pour vos lumières ;-)

PS : pour résumer, je souhaite augmenter la longueur du texte, le m ettre
en
gras, en blanc sur fond rouge, et dans un cadre de la bonne taille !

--
Cordialement @+
JP- Masquer le texte des messages précédents -


- Afficher le texte des messages précédents -- Masquer le texte des messages précédents -


- Afficher le texte des messages précédents -




j-pascal
Le #4814331
Re,

"JB"
-La procédure CreeShape() crée le shape MonShape si celui a été
supprimé.

Pas compris ! Je ne vois pas comment il "pourrait" être supprimé (par quelle
opération) !
Ca m'intéresse de savoir comment le supprimer, comme ça je pourrai tester le
code que j'ai ajusté (et provisoirement supprimé !) dans CreeShape ...

Fallait-il bien modifier le "Worksheet_SelectionChange" ?

Je vais refaire des essais avec "Selection" et "Shapes("Monshape").Select"

@+ ?

JP


-Selection... n'a de sens que si l'on a sélectionné le shape avec
Shapes("Monshape").Select

JB


On 31 juil, 09:43, "j-pascal"
Bonjour JB,

Merci pour le fichier joint. J'apprécie bcp le résumé du code dans une
"image".

Dans mon classeur, ça ne marche (apparemment !) que si j'ajuste aussi le
code du "Worksheet_SelectionChange", comme ceci :

--------------------------------------------------------
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Not Intersect(Target, [MoisInterdit]) Is Nothing And Target.Count = 1
Then 'modif du 30/07/07
ActiveWorkbook.Names.Add Name:="mémo", RefersToR1C1:="=" & Chr(34) &
Target.Value & Chr(34)

compteur = 0
For Each com In Range("p" & Target.Row & ":at" & Target.Row)
If Len(com.NoteText) Then compteur = 1: Exit For
Next
If Application.Sum(Range("f" & Target.Row & ":" & "m" &
Target.Row)) > 0 Or compteur = 1 Then

On Error Resume Next

Shapes("monshape").Visible = True
If Err <> 0 Then creeShape: Target.Select

Shapes("monshape").Left = ActiveCell.Left
Shapes("monshape").Top = ActiveCell.Top + ActiveCell.Height + 3
Shapes("monshape").TextFrame.Characters.Text = "suppression
interdite !"

Shapes("monshape").OLEFormat.Object.AutoSize = True

Shapes("monshape").OLEFormat.Object.ShapeRange.Fill.ForeColor.SchemeColor
= 2

Shapes("monshape").OLEFormat.Object.Font.Name = "Verdana"
Shapes("monshape").OLEFormat.Object.Font.Size = 8
Shapes("monshape").OLEFormat.Object.ColorIndex = 2
Shapes("monshape").OLEFormat.Object.Font.Bold = True

Else

On Error Resume Next

Shapes("monshape").Visible = False
End If
End If 'modif du 30/07/07
End Sub
---------------------------------------------------------------------------­---

Je me suis rendu compte que les formes : "Selection.etc" n'avait
(apparemment) pas d'effet.
Seules fonctionnent les formes : "Shapes("monshape").OLEFormat.Object.etc"

J'ai fait plein d'ajustement, et pour finir, je me suis rendu compte (!!!)
que si je garde le code ci-dessus (Private Sub Worksheet_SelectionChange)
et
que j'enlève TOUT le code compris entre "Sub creeShape()" et "End Sub",
tout
semble fonctionner très bien !

Je suis un peu désolé d'avoir "massacré" le code que tu viens de me donner
et il est fort possible qu'un truc m'ait échappé ...

Fallait-il modifier le code de "Private Sub Worksheet_SelectionChange" ?

@+ ?

JP

"JB"
Ajustement auto:

Shapes("monshape").OLEFormat.Object.AutoSize = True

Modif couleur fond:

Shapes("monshape").OLEFormat.Object.ShapeRange.Fill.ForeColor.SchemeColor
= 21

JB

On 31 juil, 08:01, JB


Bonjour,

Longueur:70
Hauteur:10
Couleur fond:10

Sub creeShape()
Shapes.AddTextbox(msoTextOrientationHorizontal, 1, 1, 70, 10).Select
Selection.Name = "monshape"
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 10
Selection.Font.Name = "Verdana"
Selection.Font.Size = 8
Selection.Font.ColorIndex = 2
Selection.Font.Bold = True
Shapes("monshape").Left = ActiveCell.Left
Shapes("monshape").Top = ActiveCell.Top + ActiveCell.Height + 3
End Sub

http://cjoint.com/?hFibqEDUoj

JB

On 30 juil, 23:51, "j-pascal"
Bonjour,

L'auteur du code suivant se reconnaitra ;-)

Comment puis-je modifier certains paramètres du "Shape" ?

Shapes("monshape").Visible = True
If Err <> 0 Then CreeShape: Target.Select

Shapes("monshape").Left = ActiveCell.Left
Shapes("monshape").Top = ActiveCell.Top + ActiveCell.Height +
3
Shapes("monshape").TextFrame.Characters.Text = "suppr.
interdite"

1 - J'ai trouvé ça pour mettre la police en blanc sur fond rouge ...

Shapes("monshape").OLEFormat.Object.Font.ColorIndex = 2
Shapes("monshape").OLEFormat.Object.Interior.ColorIndex = 3

2 - L'ajustement du texte à la taille automatique ne fonctionne pas !
Je
dois augmenter le texte !

Shapes("monshape").Selection.AutoSize = True

3 - Le reste du code est là :

Sub CreeShape()

Shapes.AddTextbox(msoTextOrientationHorizontal, 1, 1, 50, 10).Select
Selection.Font.Name = "Verdana"
Selection.Font.Size = 7
Selection.Name = "monshape"
Shapes("monshape").Left = ActiveCell.Left
Shapes("monshape").Top = ActiveCell.Top + ActiveCell.Height + 3
'Shapes("monshape").Selection.AutoSize = True

End Sub

J'ai du mal à différencier les paramètres du Shape en fonction du code
ci-dessus et celui du haut du présent message ...

Merci pour vos lumières ;-)

PS : pour résumer, je souhaite augmenter la longueur du texte, le
mettre
en
gras, en blanc sur fond rouge, et dans un cadre de la bonne taille !

--
Cordialement @+
JP- Masquer le texte des messages précédents -


- Afficher le texte des messages précédents -- Masquer le texte des
messages précédents -


- Afficher le texte des messages précédents -




JB
Le #4813971
En le sélectionnant et en appuyant sur la touche suppr par exemple!

JB
On 31 juil, 15:20, "j-pascal"
Re,

"JB"
-La procédure CreeShape() crée le shape MonShape si celui a été
supprimé.

Pas compris ! Je ne vois pas comment il "pourrait" être supprimé (par quelle
opération) !
Ca m'intéresse de savoir comment le supprimer, comme ça je pourrai te ster le
code que j'ai ajusté (et provisoirement supprimé !) dans CreeShape ...

Fallait-il bien modifier le "Worksheet_SelectionChange" ?

Je vais refaire des essais avec "Selection" et "Shapes("Monshape").Select"

@+ ?

JP

-Selection... n'a de sens que si l'on a sélectionné le shape avec
Shapes("Monshape").Select

JB

On 31 juil, 09:43, "j-pascal"


Bonjour JB,

Merci pour le fichier joint. J'apprécie bcp le résumé du code dan s une
"image".

Dans mon classeur, ça ne marche (apparemment !) que si j'ajuste aussi le
code du "Worksheet_SelectionChange", comme ceci :

--------------------------------------------------------
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Not Intersect(Target, [MoisInterdit]) Is Nothing And Target.Count = 1
Then 'modif du 30/07/07
ActiveWorkbook.Names.Add Name:="mémo", RefersToR1C1:="=" & Chr(34) &
Target.Value & Chr(34)

compteur = 0
For Each com In Range("p" & Target.Row & ":at" & Target.Row)
If Len(com.NoteText) Then compteur = 1: Exit For
Next
If Application.Sum(Range("f" & Target.Row & ":" & "m" &
Target.Row)) > 0 Or compteur = 1 Then

On Error Resume Next

Shapes("monshape").Visible = True
If Err <> 0 Then creeShape: Target.Select

Shapes("monshape").Left = ActiveCell.Left
Shapes("monshape").Top = ActiveCell.Top + ActiveCell.Height + 3
Shapes("monshape").TextFrame.Characters.Text = "suppression
interdite !"

Shapes("monshape").OLEFormat.Object.AutoSize = True

Shapes("monshape").OLEFormat.Object.ShapeRange.Fill.ForeColor.SchemeCol or
= 2

Shapes("monshape").OLEFormat.Object.Font.Name = "Verdana"
Shapes("monshape").OLEFormat.Object.Font.Size = 8
Shapes("monshape").OLEFormat.Object.ColorIndex = 2
Shapes("monshape").OLEFormat.Object.Font.Bold = True

Else

On Error Resume Next

Shapes("monshape").Visible = False
End If
End If 'modif du 30/07/07
End Sub
----------------------------------------------------------------------- ----­­---

Je me suis rendu compte que les formes : "Selection.etc" n'avait
(apparemment) pas d'effet.
Seules fonctionnent les formes : "Shapes("monshape").OLEFormat.Object.e tc"

J'ai fait plein d'ajustement, et pour finir, je me suis rendu compte (! !!)
que si je garde le code ci-dessus (Private Sub Worksheet_SelectionChang e)
et
que j'enlève TOUT le code compris entre "Sub creeShape()" et "End Sub ",
tout
semble fonctionner très bien !

Je suis un peu désolé d'avoir "massacré" le code que tu viens de me donner
et il est fort possible qu'un truc m'ait échappé ...

Fallait-il modifier le code de "Private Sub Worksheet_SelectionChange" ?

@+ ?

JP

"JB"
Ajustement auto:

Shapes("monshape").OLEFormat.Object.AutoSize = True

Modif couleur fond:

Shapes("monshape").OLEFormat.Object.ShapeRange.Fill.ForeColor.SchemeCol or
= 21

JB

On 31 juil, 08:01, JB
Bonjour,

Longueur:70
Hauteur:10
Couleur fond:10

Sub creeShape()
Shapes.AddTextbox(msoTextOrientationHorizontal, 1, 1, 70, 10).Select
Selection.Name = "monshape"
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 10
Selection.Font.Name = "Verdana"
Selection.Font.Size = 8
Selection.Font.ColorIndex = 2
Selection.Font.Bold = True
Shapes("monshape").Left = ActiveCell.Left
Shapes("monshape").Top = ActiveCell.Top + ActiveCell.Height + 3
End Sub

http://cjoint.com/?hFibqEDUoj

JB

On 30 juil, 23:51, "j-pascal"
Bonjour,

L'auteur du code suivant se reconnaitra ;-)

Comment puis-je modifier certains paramètres du "Shape" ?

Shapes("monshape").Visible = True
If Err <> 0 Then CreeShape: Target.Select

Shapes("monshape").Left = ActiveCell.Left
Shapes("monshape").Top = ActiveCell.Top + ActiveCell.Hei ght +
3
Shapes("monshape").TextFrame.Characters.Text = "suppr.
interdite"

1 - J'ai trouvé ça pour mettre la police en blanc sur fond roug e ...

Shapes("monshape").OLEFormat.Object.Font.ColorIndex = 2
Shapes("monshape").OLEFormat.Object.Interior.ColorIndex = 3

2 - L'ajustement du texte à la taille automatique ne fonctionne p as !
Je
dois augmenter le texte !

Shapes("monshape").Selection.AutoSize = True

3 - Le reste du code est là :

Sub CreeShape()

Shapes.AddTextbox(msoTextOrientationHorizontal, 1, 1, 50, 10).Sel ect
Selection.Font.Name = "Verdana"
Selection.Font.Size = 7
Selection.Name = "monshape"
Shapes("monshape").Left = ActiveCell.Left
Shapes("monshape").Top = ActiveCell.Top + ActiveCell.Height + 3
'Shapes("monshape").Selection.AutoSize = True

End Sub

J'ai du mal à différencier les paramètres du Shape en fonctio n du code
ci-dessus et celui du haut du présent message ...

Merci pour vos lumières ;-)

PS : pour résumer, je souhaite augmenter la longueur du texte, le
mettre
en
gras, en blanc sur fond rouge, et dans un cadre de la bonne taille !

--
Cordialement @+
JP- Masquer le texte des messages précédents -


- Afficher le texte des messages précédents -- Masquer le texte d es
messages précédents -


- Afficher le texte des messages précédents -- Masquer le texte des messages précédents -


- Afficher le texte des messages précédents -





j-pascal
Le #4813831
Merci.

JP

"JB"
En le sélectionnant et en appuyant sur la touche suppr par exemple!

JB
On 31 juil, 15:20, "j-pascal"
Re,

"JB"
-La procédure CreeShape() crée le shape MonShape si celui a été
supprimé.

Pas compris ! Je ne vois pas comment il "pourrait" être supprimé (par
quelle
opération) !
Ca m'intéresse de savoir comment le supprimer, comme ça je pourrai tester
le
code que j'ai ajusté (et provisoirement supprimé !) dans CreeShape ...

Fallait-il bien modifier le "Worksheet_SelectionChange" ?

Je vais refaire des essais avec "Selection" et "Shapes("Monshape").Select"

@+ ?

JP

-Selection... n'a de sens que si l'on a sélectionné le shape avec
Shapes("Monshape").Select

JB

On 31 juil, 09:43, "j-pascal"


Bonjour JB,

Merci pour le fichier joint. J'apprécie bcp le résumé du code dans une
"image".

Dans mon classeur, ça ne marche (apparemment !) que si j'ajuste aussi le
code du "Worksheet_SelectionChange", comme ceci :

--------------------------------------------------------
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Not Intersect(Target, [MoisInterdit]) Is Nothing And Target.Count =
1
Then 'modif du 30/07/07
ActiveWorkbook.Names.Add Name:="mémo", RefersToR1C1:="=" & Chr(34) &
Target.Value & Chr(34)

compteur = 0
For Each com In Range("p" & Target.Row & ":at" & Target.Row)
If Len(com.NoteText) Then compteur = 1: Exit For
Next
If Application.Sum(Range("f" & Target.Row & ":" & "m" &
Target.Row)) > 0 Or compteur = 1 Then

On Error Resume Next

Shapes("monshape").Visible = True
If Err <> 0 Then creeShape: Target.Select

Shapes("monshape").Left = ActiveCell.Left
Shapes("monshape").Top = ActiveCell.Top + ActiveCell.Height + 3
Shapes("monshape").TextFrame.Characters.Text = "suppression
interdite !"

Shapes("monshape").OLEFormat.Object.AutoSize = True

Shapes("monshape").OLEFormat.Object.ShapeRange.Fill.ForeColor.SchemeColor
= 2

Shapes("monshape").OLEFormat.Object.Font.Name = "Verdana"
Shapes("monshape").OLEFormat.Object.Font.Size = 8
Shapes("monshape").OLEFormat.Object.ColorIndex = 2
Shapes("monshape").OLEFormat.Object.Font.Bold = True

Else

On Error Resume Next

Shapes("monshape").Visible = False
End If
End If 'modif du 30/07/07
End Sub
---------------------------------------------------------------------------­­---

Je me suis rendu compte que les formes : "Selection.etc" n'avait
(apparemment) pas d'effet.
Seules fonctionnent les formes :
"Shapes("monshape").OLEFormat.Object.etc"

J'ai fait plein d'ajustement, et pour finir, je me suis rendu compte
(!!!)
que si je garde le code ci-dessus (Private Sub
Worksheet_SelectionChange)
et
que j'enlève TOUT le code compris entre "Sub creeShape()" et "End Sub",
tout
semble fonctionner très bien !

Je suis un peu désolé d'avoir "massacré" le code que tu viens de me
donner
et il est fort possible qu'un truc m'ait échappé ...

Fallait-il modifier le code de "Private Sub Worksheet_SelectionChange" ?

@+ ?

JP

"JB"
Ajustement auto:

Shapes("monshape").OLEFormat.Object.AutoSize = True

Modif couleur fond:

Shapes("monshape").OLEFormat.Object.ShapeRange.Fill.ForeColor.SchemeColor
= 21

JB

On 31 juil, 08:01, JB
Bonjour,

Longueur:70
Hauteur:10
Couleur fond:10

Sub creeShape()
Shapes.AddTextbox(msoTextOrientationHorizontal, 1, 1, 70, 10).Select
Selection.Name = "monshape"
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 10
Selection.Font.Name = "Verdana"
Selection.Font.Size = 8
Selection.Font.ColorIndex = 2
Selection.Font.Bold = True
Shapes("monshape").Left = ActiveCell.Left
Shapes("monshape").Top = ActiveCell.Top + ActiveCell.Height + 3
End Sub

http://cjoint.com/?hFibqEDUoj

JB

On 30 juil, 23:51, "j-pascal"
Bonjour,

L'auteur du code suivant se reconnaitra ;-)

Comment puis-je modifier certains paramètres du "Shape" ?

Shapes("monshape").Visible = True
If Err <> 0 Then CreeShape: Target.Select

Shapes("monshape").Left = ActiveCell.Left
Shapes("monshape").Top = ActiveCell.Top + ActiveCell.Height
+
3
Shapes("monshape").TextFrame.Characters.Text = "suppr.
interdite"

1 - J'ai trouvé ça pour mettre la police en blanc sur fond rouge ...

Shapes("monshape").OLEFormat.Object.Font.ColorIndex = 2
Shapes("monshape").OLEFormat.Object.Interior.ColorIndex = 3

2 - L'ajustement du texte à la taille automatique ne fonctionne pas
!
Je
dois augmenter le texte !

Shapes("monshape").Selection.AutoSize = True

3 - Le reste du code est là :

Sub CreeShape()

Shapes.AddTextbox(msoTextOrientationHorizontal, 1, 1, 50,
10).Select
Selection.Font.Name = "Verdana"
Selection.Font.Size = 7
Selection.Name = "monshape"
Shapes("monshape").Left = ActiveCell.Left
Shapes("monshape").Top = ActiveCell.Top + ActiveCell.Height + 3
'Shapes("monshape").Selection.AutoSize = True

End Sub

J'ai du mal à différencier les paramètres du Shape en fonction du
code
ci-dessus et celui du haut du présent message ...

Merci pour vos lumières ;-)

PS : pour résumer, je souhaite augmenter la longueur du texte, le
mettre
en
gras, en blanc sur fond rouge, et dans un cadre de la bonne taille !

--
Cordialement @+
JP- Masquer le texte des messages précédents -


- Afficher le texte des messages précédents -- Masquer le texte des
messages précédents -


- Afficher le texte des messages précédents -- Masquer le texte des
messages précédents -


- Afficher le texte des messages précédents -





Publicité
Poster une réponse
Anonyme