Discussion :

[NathBlues]

Bonjour à tous,

Tout d'abord un grand bravo a toute la communauté pour faire vivre ce forum, un vrai puits d'informations !

J'aurais cependant besoin d'un petit coup de main pour la création d'une macro. Je cherche a créer d’après une liste de colis et leurs dimensions (2 colonnes, longueur et largeur), des rectangles symbolisant des palettes, a l’échelle 1 cm = 1 mm sur Excel et de pouvoir les mettres dans un autre shape symbolisant un camion ou palette ( et après c'est Tetris ^^). Le soucis est que la formule AddShape est en points et que si je multiplie ma variable avec un ratio 1cm=1pt, l'arrondi fais que je tombe jamais vraiment juste, pas facile pour justement être précis.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
Sub creationPalette()
 
'Déclaration des variables
Dim num As String
Dim lar As Integer
Dim lon As Integer
Dim i As Integer
 
 
'Creation des palettes
 
For i = Range("B6").Row To Range("B6").End(xlDown).Row
        lar = (Cells(i, 2).Value / 100) * 28.3464566929
        lon = (Cells(i, 3).Value / 100) * 28.3464566929
        num = Cells(i, 1).Value
 
       ActiveSheet.Shapes.AddShape(msoShapeRectangle, 630 + (10 * i), 25, lon, lar).Select
 
    'Bordures
        With Selection.ShapeRange.Line
            .Visible = msoTrue
            .Weight = 0.75
            .ForeColor.RGB = RGB(0, 0, 0)
            .Transparency = 0
        End With
 
    'Couleurs
        With Selection.ShapeRange.Fill
            .Visible = msoTrue
            .ForeColor.ObjectThemeColor = msoThemeColorAccent5
            .ForeColor.TintAndShade = 0
            .ForeColor.Brightness = 0
            .Transparency = 0
            .Solid
        End With
 
    'Numero des palettes
        Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = _
            num
 
    'Police
        With Selection.ShapeRange(1).TextFrame2.TextRange.Characters.ParagraphFormat
            .FirstLineIndent = 0
            .Alignment = msoAlignLeft
        End With
        With Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Font
            .NameComplexScript = "+mn-cs"
            .NameFarEast = "+mn-ea"
            .Fill.Visible = msoTrue
            .Fill.ForeColor.ObjectThemeColor = msoThemeColorLight1
            .Fill.ForeColor.TintAndShade = 0
            .Fill.ForeColor.Brightness = 0
            .Fill.Transparency = 0
            .Fill.Solid
            .Size = 8
            .Name = "+mn-lt"
        End With
Next i
 
End Sub

Auriez vous une idée ?

Merci !

[Menhir]

Ce n'est pas sur Excel qu'il faut faire cette macro mais sur AutoCAD.
Les graphiques Excel ne se limitent qu'à des représentation très schématiques.

[Invité]

Bonjour,
Si j'ai bien compris, Excel vient de mettre en évidence des siècles de cotation fonctionnels!

[Invité]

Le soucis est que la formule AddShape est en points et que si je multiplie ma variable avec un ratio 1cm=1pt, l'arrondi fais que je tombe jamais vraiment juste, pas facile pour justement être précis.

Bonjour,

Il vous faut passer vos variables lar et lon en type Double au lieu d'Integer.

Cordialement.

[NathBlues]

Parfait ! Merci a tous pour votre aide