Interieur cellule

J'ai essayer des modifications, mais je n'y arrive, j'abandonne, j'ai bes oin
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:=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()
  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.Heigh t)
> > .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.Heigh t)
> > .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 ma l de
> > > cellules.
> > > comment je peux faire sans avoir à remplacer la cellule B2 à ch aque
> > > 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.Hei ght)
> > > .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.Hei ght)
> > > .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.H eight)
> > > > .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.H eight)
> > > > .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 par ties
> > > > > de
> > > > > la
> > > > > cellule ?
> > > > > --
> > > > > Cordialement
> > > > > Guy- Masquer le texte des messages précédents -

> > > > - Afficher le texte des messages précédents -- Masquer le tex te 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 -

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:=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()
  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.Heigh t)
> > .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.Heigh t)
> > .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 ma l de
> > > cellules.
> > > comment je peux faire sans avoir à remplacer la cellule B2 à ch aque
> > > 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.Hei ght)
> > > .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.Hei ght)
> > > .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.H eight)
> > > > .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.H eight)
> > > > .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 par ties
> > > > > de
> > > > > la
> > > > > cellule ?
> > > > > --
> > > > > Cordialement
> > > > > Guy- Masquer le texte des messages précédents -

> > > > - Afficher le texte des messages précédents -- Masquer le tex te 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 -

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 -- Masquer le texte des
> messages précédents -

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

La macro miroir fait l'inverse de "Bas gauche" par à port à la hauteu r.
Par contre "iso" je le souhaiterais sur deux cellules avec la pointe au
milieu des deux cellules.
Est-ce possible ?http://cjoint.com/?gvuoiFschD
--
Cordialement
Guy
"JB" a écrit dans le message de news:
: //cjoint.com/?gvtEgVeHTb

JB

On 21 juin, 19:14, "Guy72" wrote:



> 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 co de 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.Heigh t)
> > .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.Heigh t)
> > .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.Hei ght)
> > > .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.Hei ght)
> > > .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.H eight)
> > > > .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.H eight)
> > > > .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 t exte
> > > > > des
> > > > > messages précédents -

> > > > - Afficher le texte des messages précédents -- Masquer le tex te 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 -

La macro miroir fait l'inverse de "Bas gauche" par à port à la hauteur.
Par contre "iso" je le souhaiterais sur deux cellules avec la pointe au
milieu des deux cellules.
Est-ce possible ?http://cjoint.com/?gvuoiFschD
--
Cordialement
Guy
"JB" a écrit dans le message de news:
://cjoint.com/?gvtEgVeHTb

JB

On 21 juin, 19:14, "Guy72" wrote:



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

C'est parfait merci JB.
Question......
A quoi sert   ActiveSheet.Shapes(c.Address & "1").Delete ...et.....Name =
c.Address & "2"
Pourquoi 1 à un seul (Sub haut(c) ?
Pourquoi 2 aux autres ?
--
Cordialement
Guy

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


http://cjoint.com/?gvuCx88ZSr

JB

On 21 juin, 20:14, "Guy72" wrote:



> La macro miroir fait l'inverse de "Bas gauche" par à port à la haut eur.
> Par contre "iso" je le souhaiterais sur deux cellules avec la pointe au
> milieu des deux cellules.
> Est-ce possible ?http://cjoint.com/?gvuoiFschD
> --
> Cordialement
> Guy
> "JB" a écrit dans le message de news:
> p://cjoint.com/?gvtEgVeHTb

> JB

> On 21 juin, 19:14, "Guy72" wrote:

> > 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.Heigh t)
> > .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.Heigh t)
> > .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 cellule s
> > > 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.Hei ght)
> > > .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.Hei ght)
> > > .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.H eight)
> > > > .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.H eight)
> > > > .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 pa s 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 new s:
> > > > > m...
> > > > > 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:=msoShapeRightTriangl e, _
> > > > > > 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 -- Masquer le texte
> > > > > > des
> > > > > > messages précédents -

> > > > > - Afficher le texte des messages précédents -- Masquer le t exte
> > > > > des
> > > > > messages précédents -

> > > > - Afficher le texte des messages précédents -- Masquer le tex te 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 -

La macro miroir fait l'inverse de "Bas gauche" par à port à la hauteur.
Par contre "iso" je le souhaiterais sur deux cellules avec la pointe au
milieu des deux cellules.
Est-ce possible ?http://cjoint.com/?gvuoiFschD
--
Cordialement
Guy
"JB" a écrit dans le message de news:
://cjoint.com/?gvtEgVeHTb

JB

On 21 juin, 19:14, "Guy72" wrote:



> 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 -- 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'ai vu que tu pouvais le faire sur 2 cellules.
Je n'arrive pas à voir comment le faire sur 3 ou plus de cellules.
J'irais jusque à 12 cellules.
--
Cordialement
Guy

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


http://cjoint.com/?gvuCx88ZSr

JB

On 21 juin, 20:14, "Guy72" wrote:



> La macro miroir fait l'inverse de "Bas gauche" par à port à la haut eur.
> Par contre "iso" je le souhaiterais sur deux cellules avec la pointe au
> milieu des deux cellules.
> Est-ce possible ?http://cjoint.com/?gvuoiFschD
> --
> Cordialement
> Guy
> "JB" a écrit dans le message de news:
> p://cjoint.com/?gvtEgVeHTb

> JB

> On 21 juin, 19:14, "Guy72" wrote:

> > 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.Heigh t)
> > .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.Heigh t)
> > .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 cellule s
> > > 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.Hei ght)
> > > .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.Hei ght)
> > > .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.H eight)
> > > > .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.H eight)
> > > > .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 pa s 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 new s:
> > > > > m...
> > > > > 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:=msoShapeRightTriangl e, _
> > > > > > 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 -- Masquer le texte
> > > > > > des
> > > > > > messages précédents -

> > > > > - Afficher le texte des messages précédents -- Masquer le t exte
> > > > > des
> > > > > messages précédents -

> > > > - Afficher le texte des messages précédents -- Masquer le tex te 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 -

J'ai vu que tu pouvais le faire sur 2 cellules.
Je n'arrive pas à voir comment le faire sur 3 ou plus de cellules.
J'irais jusque à 12 cellules.
--
Cordialement
Guy

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


http://cjoint.com/?gvuCx88ZSr

JB

On 21 juin, 20:14, "Guy72" wrote:



> La macro miroir fait l'inverse de "Bas gauche" par à port à la hauteur.
> Par contre "iso" je le souhaiterais sur deux cellules avec la pointe au
> milieu des deux cellules.
> Est-ce possible ?http://cjoint.com/?gvuoiFschD
> --
> Cordialement
> Guy
> "JB" a écrit dans le message de news:
> ://cjoint.com/?gvtEgVeHTb

> JB

> On 21 juin, 19:14, "Guy72" wrote:

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

J'ai vu que tu pouvais le faire sur 2 cellules.
Je n'arrive pas à voir comment le faire sur 3 ou plus de cellules.
J'irais jusque à 12 cellules.
--
Cordialement
Guy

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


http://cjoint.com/?gvuCx88ZSr

JB

On 21 juin, 20:14, "Guy72" wrote:



> La macro miroir fait l'inverse de "Bas gauche" par à port à la hauteur.
> Par contre "iso" je le souhaiterais sur deux cellules avec la pointe au
> milieu des deux cellules.
> Est-ce possible ?http://cjoint.com/?gvuoiFschD
> --
> Cordialement
> Guy
> "JB" a écrit dans le message de news:
> ://cjoint.com/?gvtEgVeHTb

> JB

> On 21 juin, 19:14, "Guy72" wrote:

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