Discussion :

[Sami Xite]

Bonjour à toutes et tous,

J'aimerais créer une macro qui me permette de créer des formes auto selon des dimensions en centimètres que je spécifierais
En gros au lancement de la macro j'aimerais que me soit demandés la hauteur et la largeur désirés puis que la forme soit créée
J'ai essayé avec l'enregistreur de macro mais pas terrible

Merci d'avance pour votre aide

[Le Pierre]

bonjour

essaye cette idée qui mériterait d'être améliorée car je ne connais pas l'équivalence en cm des dimensions en pixels des formes. Il faudrait aussi saisir les coordonnées de départ de la forme que j'ai imposé (CoordX et CoordY) et de la forme souhaitée (ici j'impose un rectangle) :

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
Sub test()
    CoordX = 180.75
    CoordY = 76.5
 
    Message = "Entrez la hauteur en cm"
    Title = "Hauteur d'une forme automatique"
    Hauteur = Val(InputBox(Message, Title))
 
    Message = "Entrez la largeur en cm"
    Title = "Largeur d'une forme automatique"
    Largeur = Val(InputBox(Message, Title))
 
    ActiveSheet.Shapes.AddShape(msoShapeRectangle, CoordX, CoordY, Hauteur, Largeur). _
        Select
End Sub

à plus

[fring]

Bonjour tlm,

En partant du code de Pierre, le code ci-dessous converti les données entrées en mm, en pixels.
Il faut faire des test avec cette conversion qui est relative à la résolution de l'écran et au besoin adapter
J'attribue également un nom à la forme suivant le nombre de formes insérées dans la feuille (Forme 1, Forme 2, Forme 3, etc...)

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
Sub test()
 
    Message = "Entrez la hauteur" & Chr(10) & "(en mm)"
    Title = "Hauteur d'une forme automatique"
    Hauteur = Val(InputBox(Message, Title)) * 2.835
 
    Message = "Entrez la largeur" & Chr(10) & "(en mm)"
    Title = "Largeur d'une forme automatique"
    Largeur = Val(InputBox(Message, Title)) * 2.835
 
    Message = "Entrez la position depuis le bord gauche de la feuille" & Chr(10) & "(en mm)"
    Title = "Position horizontale d'une forme automatique"
    CoordX = Val(InputBox(Message, Title)) * 2.835
 
    Message = "Entrez la position depuis le bord supérieur de la feuille" & Chr(10) & "(en mm)"
    Title = "Position verticale d'une forme automatique"
    CoordY = Val(InputBox(Message, Title)) * 2.835
 
    With ActiveSheet.Shapes.AddShape(msoShapeRectangle, CoordX, CoordY, Hauteur, Largeur)
        .Name = "Forme " & ActiveSheet.Shapes.Count
    End With
 
End Sub

Ici aussi cela se limite au rectangle, on pourrait imaginer un UserForm qui permettrait de choisir la forme à insérer

@+

[Sami Xite]

Wahou !!! Marche nickel
Merci beaucoup !!
Si je pouvais abuser pourrais tu me dire s'il est possible d'inscrire les dimensions dans les objets ?

Merci encore à tous

[fring]

Ci-dessous le code avec inscription des dimensions et position, sur cette base tu devrais pouvoir l'adapter à tes besoins

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
Sub test()
 
    Message = "Entrez la largeur" & Chr(10) & "(en mm)"
    Title = "Hauteur d'une forme automatique"
    Lmm = Val(InputBox(Message, Title))
    Lpx = Lmm * 2.835
 
    Message = "Entrez la hauteur" & Chr(10) & "(en mm)"
    Title = "Largeur d'une forme automatique"
    Hmm = Val(InputBox(Message, Title))
    Hpx = Hmm * 2.835
 
    Message = "Entrez la position depuis le bord gauche de la feuille" & Chr(10) & "(en mm)"
    Title = "Position horizontale d'une forme automatique"
    PHmm = Val(InputBox(Message, Title))
    PHpx = PHmm * 2.835
 
 
    Message = "Entrez la position depuis le bord supérieur de la feuille" & Chr(10) & "(en mm)"
    Title = "Position verticale d'une forme automatique"
    PVmm = Val(InputBox(Message, Title))
    PVpx = PVmm * 2.835
 
    With ActiveSheet.Shapes.AddShape(msoShapeRectangle, PHpx, PVpx, Lpx, Hpx)
        .Name = "Forme " & ActiveSheet.Shapes.Count
        .TextFrame.Characters.Text = "Dimensions :" & Chr(10) _
            & "Hauteur = " & Hmm & "mm" & Chr(10) & "Largeur = " & Lmm & "mm" _
            & Chr(10) & Chr(10) & "Position :" & Chr(10) _
            & "Horizontale = " & PHmm & "mm" & Chr(10) & "Verticale = " & PVmm & "mm"
    End With
 
End Sub

[Sami Xite]

Super fring !! Comme dirait Tina Turner : "You're simply the best !!"
Ultime question : en inscrivant les mesures je ne peux plus déplacer mon objet qu'en le prenant sur les bords. Y'at'il un moyen de préserver la mobilité comme sans le texte ?
Sinon afficher les mesures après déplacement, double click sur l'objet par exemple ?

Juré après je ferme le topic

Un grand merci

[Le Pierre]

bonjour

pour déplacer l'objet contenant du texte sans le prendre par les bords, sélectionne l'outil "Sélectionner les objets" (flèche de la barre d'outil Dessin)
pour accéder ensuite aux cellules de la feuille il faut bien sûr déselectionner l'outil "flèche"

à plus