Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

modifier apparence d'un "Shape"

7 réponses
Avatar
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

7 réponses

Avatar
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" wrote:
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


Avatar
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 wrote:
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" wrote:



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 -



Avatar
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" a écrit dans le message de news:

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 wrote:
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" wrote:



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 -



Avatar
JB
-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" wrote:
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" a écrit dans le message de news:

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 wrote:



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" wrote:

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 -




Avatar
j-pascal
Re,

"JB" a écrit dans le message de news:

-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" wrote:
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" a écrit dans le message de news:

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 wrote:



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" wrote:

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 -




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

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

"JB" a écrit dans le message de news:

-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" wrote:



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" a écrit dans le message de news:

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 wrote:

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" wrote:

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 -





Avatar
j-pascal
Merci.

JP

"JB" a écrit dans le message de news:

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

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

"JB" a écrit dans le message de news:

-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" wrote:



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" a écrit dans le message de news:

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 wrote:

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" wrote:

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 -