Fonction VBA pour dessiner un drapeau écossais

[Pino12]

Bonjour le forum,

Je dois dessiner un drapeau écossais à l'aide d'une fonction pour mon cours de VBA. Seulement cela implique de créer des diagonales et de colorier uniquement la moitié d'une cellule. Après avoir chercher sur internet je n'ai toujours pas trouver de solution

Si quelqu'un à une idée sur le fonctionnement d'une telle fonction, je suis preneur !

Merci d'avance

 

[Pino12]

Re : Fonction VBA pour dessiner un drapeau écossais

Merci beaucoup Pierre !

Tu pourrais m'expliquer cette phrase s'il te plait ? Je comprends bien le reste de la macro sinon
For Each sh In ActiveSheet.Shapes
sh.Delete

 

[Pino12]

Re : Fonction VBA pour dessiner un drapeau écossais

Ok je comprends mieux !

Une dernière question, pour aligner parfaitement les triangles isocèles entre eux tu l'as fait à la main ?

 

[BOISGONTIER]

Re : Fonction VBA pour dessiner un drapeau écossais

Bonsoir,

Pour créer un drapeau Français/Italien dans une cellule ou un champ
Si un texte est déjà présent dans la cellule ou le champ, il apparaît par transparence.

=drapeauFR(Champ;Transparence)
=drapeauIT(Champ;Transparence)

http://boisgontierjacques.free.fr/fichiers/Images/ConstructeurDrapeau.xls






JB

 

[job75]

Re : Fonction VBA pour dessiner un drapeau écossais

Bonjour Pino12, tatiak, JB,

Voyez le fichier joint et cette macro :

Sub DrapeauEcossais(cel As Range)
Dim x, y, w, h, e

With cel
  x = .Left: y = .Top
  w = .Width: h = .Height
  e = Application.Min(w, h) / 8 'coefficient à adapter
End With

ActiveSheet.DrawingObjects.Delete

ActiveSheet.Shapes.AddShape msoShapeIsoscelesTriangle, x + e, y + h / 2 + e, w - 2 * e, h / 2 - e

With ActiveSheet.Shapes.AddShape(msoShapeIsoscelesTriangle, x + e, y, w - 2 * e, h / 2 - e)
  .Rotation = 180
End With

With ActiveSheet.Shapes.AddShape(msoShapeIsoscelesTriangle, 0, 0, 0, 0)
  .Rotation = 90
  .Left = x + w / 2 - e: .Top = y + e
  .Width = h - 2 * e: .Height = w / 2 - e
End With

With ActiveSheet.Shapes.AddShape(msoShapeIsoscelesTriangle, 0, 0, 0, 0)
  .Rotation = -90
  .Left = x + w / 2 + e: .Top = y + h - e
  .Width = h - 2 * e: .Height = w / 2 - e
End With

End Sub

A+

 

[job75]

Re : Fonction VBA pour dessiner un drapeau écossais

Re,

Si l'on veut définir la couleur il suffit d'ajouter un argument à la macro :

Sub DrapeauEcossais(cel As Range, couleur As Range)
Dim x, y, w, h, e

With cel
  x = .Left: y = .Top
  w = .Width: h = .Height
  e = Application.Min(w, h) / 8 'coefficient à adapter
End With

ActiveSheet.DrawingObjects.Delete

ActiveSheet.Shapes.AddShape(msoShapeIsoscelesTriangle, x + e, y + h / 2 + e, w - 2 * e, h / 2 - e) _
  .Fill.ForeColor.RGB = couleur.Interior.Color

With ActiveSheet.Shapes.AddShape(msoShapeIsoscelesTriangle, x + e, y, w - 2 * e, h / 2 - e)
  .Rotation = 180
  .Fill.ForeColor.RGB = couleur.Interior.Color
End With

With ActiveSheet.Shapes.AddShape(msoShapeIsoscelesTriangle, 0, 0, 0, 0)
  .Rotation = 90
  .Left = x + w / 2 - e: .Top = y + e
  .Width = h - 2 * e: .Height = w / 2 - e
  .Fill.ForeColor.RGB = couleur.Interior.Color
End With

With ActiveSheet.Shapes.AddShape(msoShapeIsoscelesTriangle, 0, 0, 0, 0)
  .Rotation = -90
  .Left = x + w / 2 + e: .Top = y + h - e
  .Width = h - 2 * e: .Height = w / 2 - e
  .Fill.ForeColor.RGB = couleur.Interior.Color
End With

End Sub

Fichier (2).

A+

 

[Efgé]

Re : Fonction VBA pour dessiner un drapeau écossais

Bonjour

Ne réponds pas à la question, mais pourra être utile si il y a un "cours de graph"

Cordialement

Edit: Fichier plus optimisé

 

[Pino12]

Re : Fonction VBA pour dessiner un drapeau écossais

Merci à tous avec un peu de retard ! J'avais choisi la solution de Titiak avant de me présenter ce travail en cours