Option Explicit
Sub DrawBoxes()
Dim l As Integer ' left
Dim t As Integer ' top
Dim w As Integer ' width
Dim h As Integer ' height
Dim text As String ' texte
Dim fg As Long ' foreground, couleur d'avant-plan
Dim bg As Long ' background, couleur d'arrière-plan
Dim n As Integer ' numéro de ligne en cours
InitColours
' draw on new sheet
Sheets.Add
n = 2
Do
l = Sheets("boxes").Cells(n, 1).Value
t = Sheets("boxes").Cells(n, 2).Value
w = Sheets("boxes").Cells(n, 3).Value
h = Sheets("boxes").Cells(n, 4).Value
text = Sheets("boxes").Cells(n, 5).Value
' ================================================================================================================================
' premier problème: ces deux lignes ne fonctionnent pas. Elles retournent la couleur désiré sous forme de chaine ("RED"), et je
' n'arrive pas à évaluer l'indirection afin de récupérer la valeur numérique de la variable (RED=RGB(255,0,0)).
' fg = Sheets("boxes").Cells(n, 6).Value
' bg = Sheets("boxes").Cells(n, 7).Value
' j'ai donc du mettre les couleurs sur une feuille, créer une fonction utilisateur (car RGB() est une fonction VBA), et faire une
' vlookup sur cette feuille.
' ================================================================================================================================
fg = Application.WorksheetFunction.VLookup(Sheets("boxes").Cells(n, 6).Value, Sheets("colours").Range("A:B"), 2, False)
bg = Application.WorksheetFunction.VLookup(Sheets("boxes").Cells(n, 7).Value, Sheets("colours").Range("A:B"), 2, False)
DrawBox l, t, w, h, text, fg, bg
n = n + 1
Loop Until Sheets("boxes").Cells(n, 1).Value = ""
Cells(1, 1).Select
End Sub
Private Sub DrawBox(l As Integer, _
t As Integer, _
w As Integer, _
h As Integer, _
text As String, _
fg As Long, _
bg As Long)
ActiveSheet.Shapes.AddShape(msoShapeRectangle, l, t, w, h).Select
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.Solid
Selection.ShapeRange.Fill.ForeColor.RGB = bg
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoFalse
Selection.Characters.text = text
Selection.font.Name = "arial"
Selection.font.size = 2 * h / 3
Selection.font.bold = False
Selection.font.Color = fg
Selection.HorizontalAlignment = xlCenter
Selection.VerticalAlignment = xlCenter
Selection.AutoSize = False
' ================================================================================================================================
' premier problème: cette ligne plante, alors qu'elle est donée en exemple dans l'aide, et que si on ne la mets pas, les 4 lignes
' suivantes ne servent à rien. Ceci pose un problème lorsque le texte est trop grand pour rentrer correctement dans la boite.
' Selection.ShapeRange.TextFrame.AutoMargins = True
' ================================================================================================================================
Selection.ShapeRange.TextFrame.MarginLeft = 0#
Selection.ShapeRange.TextFrame.MarginRight = 0#
Selection.ShapeRange.TextFrame.MarginTop = 0#
Selection.ShapeRange.TextFrame.MarginBottom = 0#
Selection.Placement = xlFreeFloating
Selection.PrintObject = True
End Sub
