Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel Interieur cellule

Interieur cellule

20 réponses
Avatar
Guy72
Bonsoir,
Si on peut séparer une cellule par une diagonale.
Alors peut on mettre une couleur différente dans les deux parties de la
cellule ?
--
Cordialement
Guy
Signaler un problème avec ce contenu

10 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
1 2
Avatar
JB
Bonjour,

Sub CreeShapes()
Set c = Range("B2")
With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangle, _
Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Height:=c.Heig ht)
.Fill.ForeColor.RGB = RGB(255, 0, 0)
.Line.ForeColor.RGB = RGB(255, 0, 0)
.IncrementRotation 180
End With
With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangle, _
Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Height:=c.Heig ht)
.Fill.ForeColor.RGB = RGB(0, 255, 0)
.Line.ForeColor.RGB = RGB(0, 255, 0)
End With
End Sub

Sub supshapes()
Sheets(1).DrawingObjects.Delete
End Sub

http://cjoint.com/?gviUKoFRfU

JB
http://boisgontierjacques.free.fr/


On 21 juin, 00:40, "Guy72" wrote:
Bonsoir,
Si on peut séparer une cellule par une diagonale.
Alors peut on mettre une couleur différente dans les deux parties de la
cellule ?
--
Cordialement
Guy


Avatar
JB
Avec texte:

Sub CreeShapes()
Set c = Range("B2")
With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangle, _
Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Height:=c.Heig ht)
.OLEFormat.Object.Characters.Text = "Texte"
.OLEFormat.Object.Characters.Font.Size = 7
.Fill.ForeColor.RGB = RGB(255, 0, 0)
.Line.ForeColor.RGB = RGB(255, 0, 0)
.IncrementRotation 180
End With
With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangle, _
Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Height:=c.Heig ht)
.OLEFormat.Object.Characters.Text = "Texte"
.OLEFormat.Object.Characters.Font.Size = 7
.Fill.ForeColor.RGB = RGB(0, 255, 0)
.Line.ForeColor.RGB = RGB(0, 255, 0)
End With
End Sub

Sub supshapes()
Sheets(1).DrawingObjects.Delete
End Sub

JB

On 21 juin, 08:46, JB wrote:
Bonjour,

Sub CreeShapes()
     Set c = Range("B2")
     With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangle , _
       Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Height :=c.Height)
        .Fill.ForeColor.RGB = RGB(255, 0, 0)
        .Line.ForeColor.RGB = RGB(255, 0, 0)
        .IncrementRotation 180
      End With
      With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangl e, _
       Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Height :=c.Height)
        .Fill.ForeColor.RGB = RGB(0, 255, 0)
        .Line.ForeColor.RGB = RGB(0, 255, 0)
      End With
End Sub

Sub supshapes()
   Sheets(1).DrawingObjects.Delete
End Sub

http://cjoint.com/?gviUKoFRfU

JBhttp://boisgontierjacques.free.fr/

On 21 juin, 00:40, "Guy72" wrote:



> Bonsoir,
> Si on peut séparer une cellule par une diagonale.
> Alors peut on mettre une couleur différente dans les deux parties de la
> cellule ?
> --
> Cordialement
> Guy- Masquer le texte des messages précédents -

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


Avatar
Guy72
Bonjour JB
Merci.
Par contre, j'ai l'intention de faire cette opération dans pas mal de
cellules.
comment je peux faire sans avoir à remplacer la cellule B2 à chaque fois ?
Ou de faire une copie aussi à chaque fois ?
--
Cordialement
Guy

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

Avec texte:

Sub CreeShapes()
Set c = Range("B2")
With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangle, _
Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Height:=c.Height)
.OLEFormat.Object.Characters.Text = "Texte"
.OLEFormat.Object.Characters.Font.Size = 7
.Fill.ForeColor.RGB = RGB(255, 0, 0)
.Line.ForeColor.RGB = RGB(255, 0, 0)
.IncrementRotation 180
End With
With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangle, _
Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Height:=c.Height)
.OLEFormat.Object.Characters.Text = "Texte"
.OLEFormat.Object.Characters.Font.Size = 7
.Fill.ForeColor.RGB = RGB(0, 255, 0)
.Line.ForeColor.RGB = RGB(0, 255, 0)
End With
End Sub

Sub supshapes()
Sheets(1).DrawingObjects.Delete
End Sub

JB

On 21 juin, 08:46, JB wrote:
Bonjour,

Sub CreeShapes()
Set c = Range("B2")
With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangle, _
Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Height:=c.Height)
.Fill.ForeColor.RGB = RGB(255, 0, 0)
.Line.ForeColor.RGB = RGB(255, 0, 0)
.IncrementRotation 180
End With
With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangle, _
Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Height:=c.Height)
.Fill.ForeColor.RGB = RGB(0, 255, 0)
.Line.ForeColor.RGB = RGB(0, 255, 0)
End With
End Sub

Sub supshapes()
Sheets(1).DrawingObjects.Delete
End Sub

http://cjoint.com/?gviUKoFRfU

JBhttp://boisgontierjacques.free.fr/

On 21 juin, 00:40, "Guy72" wrote:



> Bonsoir,
> Si on peut séparer une cellule par une diagonale.
> Alors peut on mettre une couleur différente dans les deux parties de la
> cellule ?
> --
> Cordialement
> Guy- Masquer le texte des messages précédents -

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


Avatar
JB
Sub essai()
CreeShapes Range("B2"), "texte1", "texte2"
CreeShapes Range("E3"), "texte3", "texte4"
End Sub

Sub CreeShapes(c, texte1, texte2)
With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangle, _
Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Height:=c.Heig ht)
.OLEFormat.Object.Characters.Text = texte1
.OLEFormat.Object.Characters.Font.Size = 7
.Fill.ForeColor.RGB = RGB(255, 0, 0)
.Line.ForeColor.RGB = RGB(255, 0, 0)
.IncrementRotation 180
End With
With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangle, _
Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Height:=c.Heig ht)
.OLEFormat.Object.Characters.Text = texte2
.OLEFormat.Object.Characters.Font.Size = 7
.Fill.ForeColor.RGB = RGB(0, 255, 0)
.Line.ForeColor.RGB = RGB(0, 255, 0)
End With
End Sub

Sub supshapes()
Sheets(1).DrawingObjects.Delete
End Sub

http://cjoint.com/?gvlK2hGqxe

JB

On 21 juin, 10:08, "Guy72" wrote:
Bonjour JB
Merci.
Par contre, j'ai l'intention de faire cette opération dans pas mal de
cellules.
comment je peux faire sans avoir à remplacer la cellule B2 à chaque f ois ?
Ou de faire une copie aussi à chaque fois ?
--
Cordialement
Guy

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

Avec texte:

Sub CreeShapes()
     Set c = Range("B2")
     With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangle , _
       Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Height :=c.Height)
        .OLEFormat.Object.Characters.Text = "Texte"
        .OLEFormat.Object.Characters.Font.Size = 7
        .Fill.ForeColor.RGB = RGB(255, 0, 0)
        .Line.ForeColor.RGB = RGB(255, 0, 0)
        .IncrementRotation 180
      End With
      With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangl e, _
       Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Height :=c.Height)
        .OLEFormat.Object.Characters.Text = "Texte"
        .OLEFormat.Object.Characters.Font.Size = 7
        .Fill.ForeColor.RGB = RGB(0, 255, 0)
        .Line.ForeColor.RGB = RGB(0, 255, 0)
      End With
End Sub

Sub supshapes()
   Sheets(1).DrawingObjects.Delete
End Sub

JB

On 21 juin, 08:46, JB wrote:



> Bonjour,

> Sub CreeShapes()
> Set c = Range("B2")
> With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangle, _
> Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Height:=c.Height)
> .Fill.ForeColor.RGB = RGB(255, 0, 0)
> .Line.ForeColor.RGB = RGB(255, 0, 0)
> .IncrementRotation 180
> End With
> With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangle, _
> Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Height:=c.Height)
> .Fill.ForeColor.RGB = RGB(0, 255, 0)
> .Line.ForeColor.RGB = RGB(0, 255, 0)
> End With
> End Sub

> Sub supshapes()
> Sheets(1).DrawingObjects.Delete
> End Sub

>http://cjoint.com/?gviUKoFRfU

> JBhttp://boisgontierjacques.free.fr/

> On 21 juin, 00:40, "Guy72" wrote:

> > Bonsoir,
> > Si on peut séparer une cellule par une diagonale.
> > Alors peut on mettre une couleur différente dans les deux parties d e la
> > cellule ?
> > --
> > Cordialement
> > Guy- 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
Sub essai()
CreeShapes Range("B2"), "texte1", "texte2"
CreeShapes Range("E3"), "texte3", "texte4"
End Sub

Sub CreeShapes(c, texte1, texte2)
On Error Resume Next
ActiveSheet.Shapes(c.Address & "1").Delete
ActiveSheet.Shapes(c.Address & "2").Delete
With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangle, _
Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Height:=c.Heig ht)
.OLEFormat.Object.Characters.Text = texte1
.OLEFormat.Object.Characters.Font.Size = 7
.Fill.ForeColor.RGB = RGB(255, 0, 0)
.Line.ForeColor.RGB = RGB(255, 0, 0)
.IncrementRotation 180
.Name = c.Address & "1"
End With
With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangle, _
Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Height:=c.Heig ht)
.OLEFormat.Object.Characters.Text = texte2
.OLEFormat.Object.Characters.Font.Size = 7
.Fill.ForeColor.RGB = RGB(0, 255, 0)
.Line.ForeColor.RGB = RGB(0, 255, 0)
.Name = c.Address & "2"
End With
End Sub

Sub supshapes()
Sheets(1).DrawingObjects.Delete
End Sub


On 21 juin, 11:36, JB wrote:
Sub essai()
  CreeShapes Range("B2"), "texte1", "texte2"
  CreeShapes Range("E3"), "texte3", "texte4"
End Sub

Sub CreeShapes(c, texte1, texte2)
     With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangle , _
       Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Height :=c.Height)
        .OLEFormat.Object.Characters.Text = texte1
        .OLEFormat.Object.Characters.Font.Size = 7
        .Fill.ForeColor.RGB = RGB(255, 0, 0)
        .Line.ForeColor.RGB = RGB(255, 0, 0)
        .IncrementRotation 180
      End With
      With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangl e, _
       Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Height :=c.Height)
        .OLEFormat.Object.Characters.Text = texte2
        .OLEFormat.Object.Characters.Font.Size = 7
        .Fill.ForeColor.RGB = RGB(0, 255, 0)
        .Line.ForeColor.RGB = RGB(0, 255, 0)
      End With
End Sub

Sub supshapes()
   Sheets(1).DrawingObjects.Delete
End Sub

http://cjoint.com/?gvlK2hGqxe

JB

On 21 juin, 10:08, "Guy72" wrote:



> Bonjour JB
> Merci.
> Par contre, j'ai l'intention de faire cette opération dans pas mal de
> cellules.
> comment je peux faire sans avoir à remplacer la cellule B2 à chaque fois ?
> Ou de faire une copie aussi à chaque fois ?
> --
> Cordialement
> Guy

> "JB" a écrit dans le message de news:
>
> Avec texte:

> Sub CreeShapes()
>      Set c = Range("B2")
>      With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriang le, _
>        Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Heig ht:=c.Height)
>         .OLEFormat.Object.Characters.Text = "Texte"
>         .OLEFormat.Object.Characters.Font.Size = 7
>         .Fill.ForeColor.RGB = RGB(255, 0, 0)
>         .Line.ForeColor.RGB = RGB(255, 0, 0)
>         .IncrementRotation 180
>       End With
>       With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTrian gle, _
>        Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Heig ht:=c.Height)
>         .OLEFormat.Object.Characters.Text = "Texte"
>         .OLEFormat.Object.Characters.Font.Size = 7
>         .Fill.ForeColor.RGB = RGB(0, 255, 0)
>         .Line.ForeColor.RGB = RGB(0, 255, 0)
>       End With
> End Sub

> Sub supshapes()
>    Sheets(1).DrawingObjects.Delete
> End Sub

> JB

> On 21 juin, 08:46, JB wrote:

> > Bonjour,

> > Sub CreeShapes()
> > Set c = Range("B2")
> > With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangle, _
> > Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Height:=c.Heigh t)
> > .Fill.ForeColor.RGB = RGB(255, 0, 0)
> > .Line.ForeColor.RGB = RGB(255, 0, 0)
> > .IncrementRotation 180
> > End With
> > With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangle, _
> > Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Height:=c.Heigh t)
> > .Fill.ForeColor.RGB = RGB(0, 255, 0)
> > .Line.ForeColor.RGB = RGB(0, 255, 0)
> > End With
> > End Sub

> > Sub supshapes()
> > Sheets(1).DrawingObjects.Delete
> > End Sub

> >http://cjoint.com/?gviUKoFRfU

> > JBhttp://boisgontierjacques.free.fr/

> > On 21 juin, 00:40, "Guy72" wrote:

> > > Bonsoir,
> > > Si on peut séparer une cellule par une diagonale.
> > > Alors peut on mettre une couleur différente dans les deux parties de la
> > > cellule ?
> > > --
> > > Cordialement
> > > Guy- 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
Guy72
Oui je comprend, il suffit que je mette le N° de cellule dans le code de la
macros, mais ce ne seras pas toujours les même cellules.
Ce qu'il faudrait, quand je sélectionne par exemple : les cellules
C3....D8....E7....etc.
Avec un bouton, je puisse effectuer la macro dans les cellule sélectionnées.
--
Cordialement
Guy

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

Sub essai()
CreeShapes Range("B2"), "texte1", "texte2"
CreeShapes Range("E3"), "texte3", "texte4"
End Sub

Sub CreeShapes(c, texte1, texte2)
On Error Resume Next
ActiveSheet.Shapes(c.Address & "1").Delete
ActiveSheet.Shapes(c.Address & "2").Delete
With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangle, _
Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Height:=c.Height)
.OLEFormat.Object.Characters.Text = texte1
.OLEFormat.Object.Characters.Font.Size = 7
.Fill.ForeColor.RGB = RGB(255, 0, 0)
.Line.ForeColor.RGB = RGB(255, 0, 0)
.IncrementRotation 180
.Name = c.Address & "1"
End With
With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangle, _
Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Height:=c.Height)
.OLEFormat.Object.Characters.Text = texte2
.OLEFormat.Object.Characters.Font.Size = 7
.Fill.ForeColor.RGB = RGB(0, 255, 0)
.Line.ForeColor.RGB = RGB(0, 255, 0)
.Name = c.Address & "2"
End With
End Sub

Sub supshapes()
Sheets(1).DrawingObjects.Delete
End Sub


On 21 juin, 11:36, JB wrote:
Sub essai()
CreeShapes Range("B2"), "texte1", "texte2"
CreeShapes Range("E3"), "texte3", "texte4"
End Sub

Sub CreeShapes(c, texte1, texte2)
With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangle, _
Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Height:=c.Height)
.OLEFormat.Object.Characters.Text = texte1
.OLEFormat.Object.Characters.Font.Size = 7
.Fill.ForeColor.RGB = RGB(255, 0, 0)
.Line.ForeColor.RGB = RGB(255, 0, 0)
.IncrementRotation 180
End With
With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangle, _
Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Height:=c.Height)
.OLEFormat.Object.Characters.Text = texte2
.OLEFormat.Object.Characters.Font.Size = 7
.Fill.ForeColor.RGB = RGB(0, 255, 0)
.Line.ForeColor.RGB = RGB(0, 255, 0)
End With
End Sub

Sub supshapes()
Sheets(1).DrawingObjects.Delete
End Sub

http://cjoint.com/?gvlK2hGqxe

JB

On 21 juin, 10:08, "Guy72" wrote:



> Bonjour JB
> Merci.
> Par contre, j'ai l'intention de faire cette opération dans pas mal de
> cellules.
> comment je peux faire sans avoir à remplacer la cellule B2 à chaque fois
> ?
> Ou de faire une copie aussi à chaque fois ?
> --
> Cordialement
> Guy

> "JB" a écrit dans le message de news:
>
> Avec texte:

> Sub CreeShapes()
> Set c = Range("B2")
> With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangle, _
> Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Height:=c.Height)
> .OLEFormat.Object.Characters.Text = "Texte"
> .OLEFormat.Object.Characters.Font.Size = 7
> .Fill.ForeColor.RGB = RGB(255, 0, 0)
> .Line.ForeColor.RGB = RGB(255, 0, 0)
> .IncrementRotation 180
> End With
> With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangle, _
> Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Height:=c.Height)
> .OLEFormat.Object.Characters.Text = "Texte"
> .OLEFormat.Object.Characters.Font.Size = 7
> .Fill.ForeColor.RGB = RGB(0, 255, 0)
> .Line.ForeColor.RGB = RGB(0, 255, 0)
> End With
> End Sub

> Sub supshapes()
> Sheets(1).DrawingObjects.Delete
> End Sub

> JB

> On 21 juin, 08:46, JB wrote:

> > Bonjour,

> > Sub CreeShapes()
> > Set c = Range("B2")
> > With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangle, _
> > Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Height:=c.Height)
> > .Fill.ForeColor.RGB = RGB(255, 0, 0)
> > .Line.ForeColor.RGB = RGB(255, 0, 0)
> > .IncrementRotation 180
> > End With
> > With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangle, _
> > Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Height:=c.Height)
> > .Fill.ForeColor.RGB = RGB(0, 255, 0)
> > .Line.ForeColor.RGB = RGB(0, 255, 0)
> > End With
> > End Sub

> > Sub supshapes()
> > Sheets(1).DrawingObjects.Delete
> > End Sub

> >http://cjoint.com/?gviUKoFRfU

> > JBhttp://boisgontierjacques.free.fr/

> > On 21 juin, 00:40, "Guy72" wrote:

> > > Bonsoir,
> > > Si on peut séparer une cellule par une diagonale.
> > > Alors peut on mettre une couleur différente dans les deux parties de
> > > la
> > > cellule ?
> > > --
> > > Cordialement
> > > Guy- 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 -


Avatar
JB
Sub essai2()
For Each c In Selection
CreeShapes c, "texte1", "texte2"
Next c
End Sub

Sub CreeShapes(c, texte1, texte2)
On Error Resume Next
ActiveSheet.Shapes(c.Address & "1").Delete
ActiveSheet.Shapes(c.Address & "2").Delete
With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangle, _
Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Height:=c.Heig ht)
.OLEFormat.Object.Characters.Text = texte1
.OLEFormat.Object.Characters.Font.Size = 7
.Fill.ForeColor.RGB = RGB(255, 0, 0)
.Line.ForeColor.RGB = RGB(255, 0, 0)
.IncrementRotation 180
.Name = c.Address & "1"
End With
With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangle, _
Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Height:=c.Heig ht)
.OLEFormat.Object.Characters.Text = texte2
.OLEFormat.Object.Characters.Font.Size = 7
.Fill.ForeColor.RGB = RGB(0, 255, 0)
.Line.ForeColor.RGB = RGB(0, 255, 0)
.Name = c.Address & "2"
End With
End Sub

Sub supshapes()
For Each c In ActiveSheet.Shapes
If c.Type = 1 Then c.Delete
Next c
End Sub

http://cjoint.com/?gvp1rRz2wn

JB

On 21 juin, 15:07, "Guy72" wrote:
Oui je comprend, il suffit que je mette le N° de cellule dans le code d e la
macros, mais ce ne seras pas toujours les même cellules.
Ce qu'il faudrait, quand je sélectionne par exemple : les cellules
C3....D8....E7....etc.
Avec un bouton, je puisse effectuer la macro dans les cellule sélection nées.
--
Cordialement
Guy

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

Sub essai()
  CreeShapes Range("B2"), "texte1", "texte2"
  CreeShapes Range("E3"), "texte3", "texte4"
End Sub

Sub CreeShapes(c, texte1, texte2)
     On Error Resume Next
     ActiveSheet.Shapes(c.Address & "1").Delete
     ActiveSheet.Shapes(c.Address & "2").Delete
     With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangle , _
       Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Height :=c.Height)
        .OLEFormat.Object.Characters.Text = texte1
        .OLEFormat.Object.Characters.Font.Size = 7
        .Fill.ForeColor.RGB = RGB(255, 0, 0)
        .Line.ForeColor.RGB = RGB(255, 0, 0)
        .IncrementRotation 180
        .Name = c.Address & "1"
      End With
      With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangl e, _
       Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Height :=c.Height)
        .OLEFormat.Object.Characters.Text = texte2
        .OLEFormat.Object.Characters.Font.Size = 7
        .Fill.ForeColor.RGB = RGB(0, 255, 0)
        .Line.ForeColor.RGB = RGB(0, 255, 0)
        .Name = c.Address & "2"
      End With
End Sub

Sub supshapes()
   Sheets(1).DrawingObjects.Delete
End Sub

On 21 juin, 11:36, JB wrote:



> Sub essai()
> CreeShapes Range("B2"), "texte1", "texte2"
> CreeShapes Range("E3"), "texte3", "texte4"
> End Sub

> Sub CreeShapes(c, texte1, texte2)
> With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangle, _
> Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Height:=c.Height)
> .OLEFormat.Object.Characters.Text = texte1
> .OLEFormat.Object.Characters.Font.Size = 7
> .Fill.ForeColor.RGB = RGB(255, 0, 0)
> .Line.ForeColor.RGB = RGB(255, 0, 0)
> .IncrementRotation 180
> End With
> With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangle, _
> Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Height:=c.Height)
> .OLEFormat.Object.Characters.Text = texte2
> .OLEFormat.Object.Characters.Font.Size = 7
> .Fill.ForeColor.RGB = RGB(0, 255, 0)
> .Line.ForeColor.RGB = RGB(0, 255, 0)
> End With
> End Sub

> Sub supshapes()
> Sheets(1).DrawingObjects.Delete
> End Sub

>http://cjoint.com/?gvlK2hGqxe

> JB

> On 21 juin, 10:08, "Guy72" wrote:

> > Bonjour JB
> > Merci.
> > Par contre, j'ai l'intention de faire cette opération dans pas mal de
> > cellules.
> > comment je peux faire sans avoir à remplacer la cellule B2 à chaq ue fois
> > ?
> > Ou de faire une copie aussi à chaque fois ?
> > --
> > Cordialement
> > Guy

> > "JB" a écrit dans le message de news:
> >
> > Avec texte:

> > Sub CreeShapes()
> > Set c = Range("B2")
> > With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangle, _
> > Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Height:=c.Heigh t)
> > .OLEFormat.Object.Characters.Text = "Texte"
> > .OLEFormat.Object.Characters.Font.Size = 7
> > .Fill.ForeColor.RGB = RGB(255, 0, 0)
> > .Line.ForeColor.RGB = RGB(255, 0, 0)
> > .IncrementRotation 180
> > End With
> > With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangle, _
> > Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Height:=c.Heigh t)
> > .OLEFormat.Object.Characters.Text = "Texte"
> > .OLEFormat.Object.Characters.Font.Size = 7
> > .Fill.ForeColor.RGB = RGB(0, 255, 0)
> > .Line.ForeColor.RGB = RGB(0, 255, 0)
> > End With
> > End Sub

> > Sub supshapes()
> > Sheets(1).DrawingObjects.Delete
> > End Sub

> > JB

> > On 21 juin, 08:46, JB wrote:

> > > Bonjour,

> > > Sub CreeShapes()
> > > Set c = Range("B2")
> > > With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangle, _
> > > Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Height:=c.Hei ght)
> > > .Fill.ForeColor.RGB = RGB(255, 0, 0)
> > > .Line.ForeColor.RGB = RGB(255, 0, 0)
> > > .IncrementRotation 180
> > > End With
> > > With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangle, _
> > > Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Height:=c.Hei ght)
> > > .Fill.ForeColor.RGB = RGB(0, 255, 0)
> > > .Line.ForeColor.RGB = RGB(0, 255, 0)
> > > End With
> > > End Sub

> > > Sub supshapes()
> > > Sheets(1).DrawingObjects.Delete
> > > End Sub

> > >http://cjoint.com/?gviUKoFRfU

> > > JBhttp://boisgontierjacques.free.fr/

> > > On 21 juin, 00:40, "Guy72" wrote:

> > > > Bonsoir,
> > > > Si on peut séparer une cellule par une diagonale.
> > > > Alors peut on mettre une couleur différente dans les deux parti es de
> > > > la
> > > > cellule ?
> > > > --
> > > > Cordialement
> > > > Guy- 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 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
Guy72
OK, Merci encore JB
--
Cordialement
Guy

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


Sub essai2()
For Each c In Selection
CreeShapes c, "texte1", "texte2"
Next c
End Sub

Sub CreeShapes(c, texte1, texte2)
On Error Resume Next
ActiveSheet.Shapes(c.Address & "1").Delete
ActiveSheet.Shapes(c.Address & "2").Delete
With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangle, _
Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Height:=c.Height)
.OLEFormat.Object.Characters.Text = texte1
.OLEFormat.Object.Characters.Font.Size = 7
.Fill.ForeColor.RGB = RGB(255, 0, 0)
.Line.ForeColor.RGB = RGB(255, 0, 0)
.IncrementRotation 180
.Name = c.Address & "1"
End With
With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangle, _
Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Height:=c.Height)
.OLEFormat.Object.Characters.Text = texte2
.OLEFormat.Object.Characters.Font.Size = 7
.Fill.ForeColor.RGB = RGB(0, 255, 0)
.Line.ForeColor.RGB = RGB(0, 255, 0)
.Name = c.Address & "2"
End With
End Sub

Sub supshapes()
For Each c In ActiveSheet.Shapes
If c.Type = 1 Then c.Delete
Next c
End Sub

http://cjoint.com/?gvp1rRz2wn

JB

On 21 juin, 15:07, "Guy72" wrote:
Oui je comprend, il suffit que je mette le N° de cellule dans le code de
la
macros, mais ce ne seras pas toujours les même cellules.
Ce qu'il faudrait, quand je sélectionne par exemple : les cellules
C3....D8....E7....etc.
Avec un bouton, je puisse effectuer la macro dans les cellule
sélectionnées.
--
Cordialement
Guy

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

Sub essai()
CreeShapes Range("B2"), "texte1", "texte2"
CreeShapes Range("E3"), "texte3", "texte4"
End Sub

Sub CreeShapes(c, texte1, texte2)
On Error Resume Next
ActiveSheet.Shapes(c.Address & "1").Delete
ActiveSheet.Shapes(c.Address & "2").Delete
With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangle, _
Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Height:=c.Height)
.OLEFormat.Object.Characters.Text = texte1
.OLEFormat.Object.Characters.Font.Size = 7
.Fill.ForeColor.RGB = RGB(255, 0, 0)
.Line.ForeColor.RGB = RGB(255, 0, 0)
.IncrementRotation 180
.Name = c.Address & "1"
End With
With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangle, _
Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Height:=c.Height)
.OLEFormat.Object.Characters.Text = texte2
.OLEFormat.Object.Characters.Font.Size = 7
.Fill.ForeColor.RGB = RGB(0, 255, 0)
.Line.ForeColor.RGB = RGB(0, 255, 0)
.Name = c.Address & "2"
End With
End Sub

Sub supshapes()
Sheets(1).DrawingObjects.Delete
End Sub

On 21 juin, 11:36, JB wrote:



> Sub essai()
> CreeShapes Range("B2"), "texte1", "texte2"
> CreeShapes Range("E3"), "texte3", "texte4"
> End Sub

> Sub CreeShapes(c, texte1, texte2)
> With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangle, _
> Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Height:=c.Height)
> .OLEFormat.Object.Characters.Text = texte1
> .OLEFormat.Object.Characters.Font.Size = 7
> .Fill.ForeColor.RGB = RGB(255, 0, 0)
> .Line.ForeColor.RGB = RGB(255, 0, 0)
> .IncrementRotation 180
> End With
> With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangle, _
> Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Height:=c.Height)
> .OLEFormat.Object.Characters.Text = texte2
> .OLEFormat.Object.Characters.Font.Size = 7
> .Fill.ForeColor.RGB = RGB(0, 255, 0)
> .Line.ForeColor.RGB = RGB(0, 255, 0)
> End With
> End Sub

> Sub supshapes()
> Sheets(1).DrawingObjects.Delete
> End Sub

>http://cjoint.com/?gvlK2hGqxe

> JB

> On 21 juin, 10:08, "Guy72" wrote:

> > Bonjour JB
> > Merci.
> > Par contre, j'ai l'intention de faire cette opération dans pas mal de
> > cellules.
> > comment je peux faire sans avoir à remplacer la cellule B2 à chaque
> > fois
> > ?
> > Ou de faire une copie aussi à chaque fois ?
> > --
> > Cordialement
> > Guy

> > "JB" a écrit dans le message de news:
> >
> > Avec texte:

> > Sub CreeShapes()
> > Set c = Range("B2")
> > With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangle, _
> > Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Height:=c.Height)
> > .OLEFormat.Object.Characters.Text = "Texte"
> > .OLEFormat.Object.Characters.Font.Size = 7
> > .Fill.ForeColor.RGB = RGB(255, 0, 0)
> > .Line.ForeColor.RGB = RGB(255, 0, 0)
> > .IncrementRotation 180
> > End With
> > With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangle, _
> > Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Height:=c.Height)
> > .OLEFormat.Object.Characters.Text = "Texte"
> > .OLEFormat.Object.Characters.Font.Size = 7
> > .Fill.ForeColor.RGB = RGB(0, 255, 0)
> > .Line.ForeColor.RGB = RGB(0, 255, 0)
> > End With
> > End Sub

> > Sub supshapes()
> > Sheets(1).DrawingObjects.Delete
> > End Sub

> > JB

> > On 21 juin, 08:46, JB wrote:

> > > Bonjour,

> > > Sub CreeShapes()
> > > Set c = Range("B2")
> > > With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangle, _
> > > Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Height:=c.Height)
> > > .Fill.ForeColor.RGB = RGB(255, 0, 0)
> > > .Line.ForeColor.RGB = RGB(255, 0, 0)
> > > .IncrementRotation 180
> > > End With
> > > With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangle, _
> > > Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Height:=c.Height)
> > > .Fill.ForeColor.RGB = RGB(0, 255, 0)
> > > .Line.ForeColor.RGB = RGB(0, 255, 0)
> > > End With
> > > End Sub

> > > Sub supshapes()
> > > Sheets(1).DrawingObjects.Delete
> > > End Sub

> > >http://cjoint.com/?gviUKoFRfU

> > > JBhttp://boisgontierjacques.free.fr/

> > > On 21 juin, 00:40, "Guy72" wrote:

> > > > Bonsoir,
> > > > Si on peut séparer une cellule par une diagonale.
> > > > Alors peut on mettre une couleur différente dans les deux parties
> > > > de
> > > > la
> > > > cellule ?
> > > > --
> > > > Cordialement
> > > > Guy- 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 -- Masquer le texte des
> messages précédents -

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


Avatar
Guy72
J'ai essayer des modifications, mais je n'y arrive, j'abandonne, j'ai besoin
encore de ton aide.
Comment obtenir la sélection avec les macros "Bleu et Miroir"

http://cjoint.com/?gvsMecA0m0
--
Cordialement
Guy

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


Sub essai2()
For Each c In Selection
CreeShapes c, "texte1", "texte2"
Next c
End Sub

Sub CreeShapes(c, texte1, texte2)
On Error Resume Next
ActiveSheet.Shapes(c.Address & "1").Delete
ActiveSheet.Shapes(c.Address & "2").Delete
With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangle, _
Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Height:=c.Height)
.OLEFormat.Object.Characters.Text = texte1
.OLEFormat.Object.Characters.Font.Size = 7
.Fill.ForeColor.RGB = RGB(255, 0, 0)
.Line.ForeColor.RGB = RGB(255, 0, 0)
.IncrementRotation 180
.Name = c.Address & "1"
End With
With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangle, _
Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Height:=c.Height)
.OLEFormat.Object.Characters.Text = texte2
.OLEFormat.Object.Characters.Font.Size = 7
.Fill.ForeColor.RGB = RGB(0, 255, 0)
.Line.ForeColor.RGB = RGB(0, 255, 0)
.Name = c.Address & "2"
End With
End Sub

Sub supshapes()
For Each c In ActiveSheet.Shapes
If c.Type = 1 Then c.Delete
Next c
End Sub

http://cjoint.com/?gvp1rRz2wn

JB

On 21 juin, 15:07, "Guy72" wrote:
Oui je comprend, il suffit que je mette le N° de cellule dans le code de
la
macros, mais ce ne seras pas toujours les même cellules.
Ce qu'il faudrait, quand je sélectionne par exemple : les cellules
C3....D8....E7....etc.
Avec un bouton, je puisse effectuer la macro dans les cellule
sélectionnées.
--
Cordialement
Guy

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

Sub essai()
CreeShapes Range("B2"), "texte1", "texte2"
CreeShapes Range("E3"), "texte3", "texte4"
End Sub

Sub CreeShapes(c, texte1, texte2)
On Error Resume Next
ActiveSheet.Shapes(c.Address & "1").Delete
ActiveSheet.Shapes(c.Address & "2").Delete
With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangle, _
Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Height:=c.Height)
.OLEFormat.Object.Characters.Text = texte1
.OLEFormat.Object.Characters.Font.Size = 7
.Fill.ForeColor.RGB = RGB(255, 0, 0)
.Line.ForeColor.RGB = RGB(255, 0, 0)
.IncrementRotation 180
.Name = c.Address & "1"
End With
With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangle, _
Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Height:=c.Height)
.OLEFormat.Object.Characters.Text = texte2
.OLEFormat.Object.Characters.Font.Size = 7
.Fill.ForeColor.RGB = RGB(0, 255, 0)
.Line.ForeColor.RGB = RGB(0, 255, 0)
.Name = c.Address & "2"
End With
End Sub

Sub supshapes()
Sheets(1).DrawingObjects.Delete
End Sub

On 21 juin, 11:36, JB wrote:



> Sub essai()
> CreeShapes Range("B2"), "texte1", "texte2"
> CreeShapes Range("E3"), "texte3", "texte4"
> End Sub

> Sub CreeShapes(c, texte1, texte2)
> With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangle, _
> Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Height:=c.Height)
> .OLEFormat.Object.Characters.Text = texte1
> .OLEFormat.Object.Characters.Font.Size = 7
> .Fill.ForeColor.RGB = RGB(255, 0, 0)
> .Line.ForeColor.RGB = RGB(255, 0, 0)
> .IncrementRotation 180
> End With
> With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangle, _
> Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Height:=c.Height)
> .OLEFormat.Object.Characters.Text = texte2
> .OLEFormat.Object.Characters.Font.Size = 7
> .Fill.ForeColor.RGB = RGB(0, 255, 0)
> .Line.ForeColor.RGB = RGB(0, 255, 0)
> End With
> End Sub

> Sub supshapes()
> Sheets(1).DrawingObjects.Delete
> End Sub

>http://cjoint.com/?gvlK2hGqxe

> JB

> On 21 juin, 10:08, "Guy72" wrote:

> > Bonjour JB
> > Merci.
> > Par contre, j'ai l'intention de faire cette opération dans pas mal de
> > cellules.
> > comment je peux faire sans avoir à remplacer la cellule B2 à chaque
> > fois
> > ?
> > Ou de faire une copie aussi à chaque fois ?
> > --
> > Cordialement
> > Guy

> > "JB" a écrit dans le message de news:
> >
> > Avec texte:

> > Sub CreeShapes()
> > Set c = Range("B2")
> > With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangle, _
> > Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Height:=c.Height)
> > .OLEFormat.Object.Characters.Text = "Texte"
> > .OLEFormat.Object.Characters.Font.Size = 7
> > .Fill.ForeColor.RGB = RGB(255, 0, 0)
> > .Line.ForeColor.RGB = RGB(255, 0, 0)
> > .IncrementRotation 180
> > End With
> > With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangle, _
> > Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Height:=c.Height)
> > .OLEFormat.Object.Characters.Text = "Texte"
> > .OLEFormat.Object.Characters.Font.Size = 7
> > .Fill.ForeColor.RGB = RGB(0, 255, 0)
> > .Line.ForeColor.RGB = RGB(0, 255, 0)
> > End With
> > End Sub

> > Sub supshapes()
> > Sheets(1).DrawingObjects.Delete
> > End Sub

> > JB

> > On 21 juin, 08:46, JB wrote:

> > > Bonjour,

> > > Sub CreeShapes()
> > > Set c = Range("B2")
> > > With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangle, _
> > > Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Height:=c.Height)
> > > .Fill.ForeColor.RGB = RGB(255, 0, 0)
> > > .Line.ForeColor.RGB = RGB(255, 0, 0)
> > > .IncrementRotation 180
> > > End With
> > > With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangle, _
> > > Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Height:=c.Height)
> > > .Fill.ForeColor.RGB = RGB(0, 255, 0)
> > > .Line.ForeColor.RGB = RGB(0, 255, 0)
> > > End With
> > > End Sub

> > > Sub supshapes()
> > > Sheets(1).DrawingObjects.Delete
> > > End Sub

> > >http://cjoint.com/?gviUKoFRfU

> > > JBhttp://boisgontierjacques.free.fr/

> > > On 21 juin, 00:40, "Guy72" wrote:

> > > > Bonsoir,
> > > > Si on peut séparer une cellule par une diagonale.
> > > > Alors peut on mettre une couleur différente dans les deux parties
> > > > de
> > > > la
> > > > cellule ?
> > > > --
> > > > Cordialement
> > > > Guy- 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 -- Masquer le texte des
> messages précédents -

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


Avatar
Guy72
J'ai réussi à faire "Miroir" mais pas "Bleu (sur deux cellules)
http://cjoint.com/?gvtog0pYJa
--
Cordialement
Guy

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


Sub essai2()
For Each c In Selection
CreeShapes c, "texte1", "texte2"
Next c
End Sub

Sub CreeShapes(c, texte1, texte2)
On Error Resume Next
ActiveSheet.Shapes(c.Address & "1").Delete
ActiveSheet.Shapes(c.Address & "2").Delete
With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangle, _
Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Height:=c.Height)
.OLEFormat.Object.Characters.Text = texte1
.OLEFormat.Object.Characters.Font.Size = 7
.Fill.ForeColor.RGB = RGB(255, 0, 0)
.Line.ForeColor.RGB = RGB(255, 0, 0)
.IncrementRotation 180
.Name = c.Address & "1"
End With
With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangle, _
Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Height:=c.Height)
.OLEFormat.Object.Characters.Text = texte2
.OLEFormat.Object.Characters.Font.Size = 7
.Fill.ForeColor.RGB = RGB(0, 255, 0)
.Line.ForeColor.RGB = RGB(0, 255, 0)
.Name = c.Address & "2"
End With
End Sub

Sub supshapes()
For Each c In ActiveSheet.Shapes
If c.Type = 1 Then c.Delete
Next c
End Sub

http://cjoint.com/?gvp1rRz2wn

JB

On 21 juin, 15:07, "Guy72" wrote:
Oui je comprend, il suffit que je mette le N° de cellule dans le code de
la
macros, mais ce ne seras pas toujours les même cellules.
Ce qu'il faudrait, quand je sélectionne par exemple : les cellules
C3....D8....E7....etc.
Avec un bouton, je puisse effectuer la macro dans les cellule
sélectionnées.
--
Cordialement
Guy

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

Sub essai()
CreeShapes Range("B2"), "texte1", "texte2"
CreeShapes Range("E3"), "texte3", "texte4"
End Sub

Sub CreeShapes(c, texte1, texte2)
On Error Resume Next
ActiveSheet.Shapes(c.Address & "1").Delete
ActiveSheet.Shapes(c.Address & "2").Delete
With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangle, _
Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Height:=c.Height)
.OLEFormat.Object.Characters.Text = texte1
.OLEFormat.Object.Characters.Font.Size = 7
.Fill.ForeColor.RGB = RGB(255, 0, 0)
.Line.ForeColor.RGB = RGB(255, 0, 0)
.IncrementRotation 180
.Name = c.Address & "1"
End With
With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangle, _
Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Height:=c.Height)
.OLEFormat.Object.Characters.Text = texte2
.OLEFormat.Object.Characters.Font.Size = 7
.Fill.ForeColor.RGB = RGB(0, 255, 0)
.Line.ForeColor.RGB = RGB(0, 255, 0)
.Name = c.Address & "2"
End With
End Sub

Sub supshapes()
Sheets(1).DrawingObjects.Delete
End Sub

On 21 juin, 11:36, JB wrote:



> Sub essai()
> CreeShapes Range("B2"), "texte1", "texte2"
> CreeShapes Range("E3"), "texte3", "texte4"
> End Sub

> Sub CreeShapes(c, texte1, texte2)
> With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangle, _
> Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Height:=c.Height)
> .OLEFormat.Object.Characters.Text = texte1
> .OLEFormat.Object.Characters.Font.Size = 7
> .Fill.ForeColor.RGB = RGB(255, 0, 0)
> .Line.ForeColor.RGB = RGB(255, 0, 0)
> .IncrementRotation 180
> End With
> With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangle, _
> Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Height:=c.Height)
> .OLEFormat.Object.Characters.Text = texte2
> .OLEFormat.Object.Characters.Font.Size = 7
> .Fill.ForeColor.RGB = RGB(0, 255, 0)
> .Line.ForeColor.RGB = RGB(0, 255, 0)
> End With
> End Sub

> Sub supshapes()
> Sheets(1).DrawingObjects.Delete
> End Sub

>http://cjoint.com/?gvlK2hGqxe

> JB

> On 21 juin, 10:08, "Guy72" wrote:

> > Bonjour JB
> > Merci.
> > Par contre, j'ai l'intention de faire cette opération dans pas mal de
> > cellules.
> > comment je peux faire sans avoir à remplacer la cellule B2 à chaque
> > fois
> > ?
> > Ou de faire une copie aussi à chaque fois ?
> > --
> > Cordialement
> > Guy

> > "JB" a écrit dans le message de news:
> >
> > Avec texte:

> > Sub CreeShapes()
> > Set c = Range("B2")
> > With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangle, _
> > Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Height:=c.Height)
> > .OLEFormat.Object.Characters.Text = "Texte"
> > .OLEFormat.Object.Characters.Font.Size = 7
> > .Fill.ForeColor.RGB = RGB(255, 0, 0)
> > .Line.ForeColor.RGB = RGB(255, 0, 0)
> > .IncrementRotation 180
> > End With
> > With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangle, _
> > Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Height:=c.Height)
> > .OLEFormat.Object.Characters.Text = "Texte"
> > .OLEFormat.Object.Characters.Font.Size = 7
> > .Fill.ForeColor.RGB = RGB(0, 255, 0)
> > .Line.ForeColor.RGB = RGB(0, 255, 0)
> > End With
> > End Sub

> > Sub supshapes()
> > Sheets(1).DrawingObjects.Delete
> > End Sub

> > JB

> > On 21 juin, 08:46, JB wrote:

> > > Bonjour,

> > > Sub CreeShapes()
> > > Set c = Range("B2")
> > > With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangle, _
> > > Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Height:=c.Height)
> > > .Fill.ForeColor.RGB = RGB(255, 0, 0)
> > > .Line.ForeColor.RGB = RGB(255, 0, 0)
> > > .IncrementRotation 180
> > > End With
> > > With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangle, _
> > > Left:=c.Left, Top:=c.Top + 1, Width:=c.Width, Height:=c.Height)
> > > .Fill.ForeColor.RGB = RGB(0, 255, 0)
> > > .Line.ForeColor.RGB = RGB(0, 255, 0)
> > > End With
> > > End Sub

> > > Sub supshapes()
> > > Sheets(1).DrawingObjects.Delete
> > > End Sub

> > >http://cjoint.com/?gviUKoFRfU

> > > JBhttp://boisgontierjacques.free.fr/

> > > On 21 juin, 00:40, "Guy72" wrote:

> > > > Bonsoir,
> > > > Si on peut séparer une cellule par une diagonale.
> > > > Alors peut on mettre une couleur différente dans les deux parties
> > > > de
> > > > la
> > > > cellule ?
> > > > --
> > > > Cordialement
> > > > Guy- 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 -- Masquer le texte des
> messages précédents -

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


1 2