XL 2010 Macro pour créer des zones de texte

[JP.ROBERT]

Bonjour à toutes et à tous.

J'ai besoin de vos lumières pour essayer de résoudre 2 problèmes pour lequel je vais essayer de vous expliquer au mieux ce que je souhaite.

Je souhaiterai créer des planches de zones de textes sur des feuilles A4, que j'aurai ensuite à découper en fonction de mes besoins.

Problème N° 1 :

a - Je dois pouvoir saisir la largeur et la hauteur de ma zone de texte qui sera ensuite répétée sur la totalité de ma page A4. Il n'y a pas nécessairement besoin d'espace entre les zones de textes mais au cas ou ce ne serait pas très gênant.

b - Il faudrait que dans chaque zone de texte s'inscrive de manière centrée verticalement et horizontalement la taille précédemment rentrée sous la forme 10 x 10 par exemple.

c - Ne pas dépasser en hauteur le format d'une page A4

Problème N° 2 :

Pour ce problème il s'agit toujours de créer des zones de texte mais ou sur chacune des lignes les zones peuvent être de largeur et de hauteur différentes.

a - Je dois pouvoir définir au départ quelle sera la largeur maximum de la ligne utilisable

b - Je dois pouvoir définir la largeur et hauteur de chacune des zones de texte d'une même ligne

c - En fonction des dimensions données répartir ces zones de texte sur la largeur de manière égale au niveau des espacements

d - Ne pas dépasser en hauteur le format d'une page A4

Merci par avance aux personnes qui pourront m'aider

 

[vgendron]

Hello

Voir PJ pour un tout début de réponse
deux boutons ==> deux actions différentes
va voir le code pour voir comment ca fonctionne (Alt+F11 pour ouvrir l'éditeur VBA)
ensuite. il faudra définir des variable pour limiter le nbr de zone de texte , ou donner une taille maxi (=somme des tailles )
ou définir tout un tas de choses dont tu auras besoin...

 

[vgendron]

plusieurs points à vérifier

1) la conversion Cm <--> nbre de Points (suis meme pas sur qu'elle soit constante d'un PC à l'autre...)
2) la taille maxi en point d'un format A4 (avec ou sans marge...?)
3) peut etre le format "etiquette" existe t il déjà sous excel...==> pourquoi réinventer la roue si les pneus tubeless existent déjà... :-D

 

[vgendron]

Voir ce code pour des zone de 10*10

Sub créer_zone_texte10_10()
LargeurCm = 10  'Définit la largeur en Cm
LongueurCm = 10

LargA4_Pt = 21 * 28
LongA4_Pt = 29.7 * 28

ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 0, 0, LargA4_Pt, LongA4_Pt).Select

LargPt = LargeurCm / 0.0352778 'convertit en point
LongPt = LongueurCm / 0.0352778
PosLar = 0
PosLong = 0
LargTotal = LargPt
LongTotal = LongPt
While LargTotal <= LargA4_Pt And LongTotal <= LongA4_Pt
    ' créer_zone_texte Macro
    ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, PosLar, PosLong, LargPt, LongPt).Select
    Selection.ShapeRange.Fill.Visible = msoTrue
    Selection.ShapeRange.Fill.Solid
    Selection.ShapeRange.Fill.ForeColor.SchemeColor = 27
    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 = msoTrue
    Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
    Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
    Selection.Characters.Text = "Taille: " & LargeurCm & "cm X " & LongueurCm & "cm"
    PosLar = PosLar + LargPt
    If PosLar + LargPt > LargA4_Pt Then
        PosLar = 0
        LargTotal = 0
        PosLong = PosLong + LongPt
        LongTotal = LongTotal + LongPt
    End If
    LargTotal = LargTotal + LargPt
   
Wend
End Sub

 

[vgendron]

et celui ci me parait pas mal du tout :-D
Reste plus qu'à trouver comment centrer

Sub créer_zone_textePerso()
'LargeurCm = 10  'Définit la largeur en Cm
'LongueurCm = 10

LargeurCm = CInt(InputBox("donner la largeur en cm de la boite à créer: ")) 'Définit la largeur en Cm
LongueurCm = CInt(InputBox("donner la longueur en cm de la boite à créer: "))

LargA4_Pt = 21 * 28
LongA4_Pt = 29.7 * 28

ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 0, 0, LargA4_Pt, LongA4_Pt).Select

LargPt = LargeurCm / 0.0352778 'convertit en point
LongPt = LongueurCm / 0.0352778
PosLar = 0
PosLong = 0
LargTotal = LargPt
LongTotal = LongPt
While LargTotal <= LargA4_Pt And LongTotal <= LongA4_Pt
    ' créer_zone_texte Macro
    ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, PosLar, PosLong, LargPt, LongPt).Select
    Selection.ShapeRange.Fill.Visible = msoTrue
    Selection.ShapeRange.Fill.Solid
    Selection.ShapeRange.Fill.ForeColor.SchemeColor = 27
    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 = msoTrue
    Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
    Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
    Selection.Characters.Text = "Taille: " & LargeurCm & "cm X " & LongueurCm & "cm"
    PosLar = PosLar + LargPt
    If PosLar + LargPt > LargA4_Pt Then
        PosLar = 0
        LargTotal = 0
        PosLong = PosLong + LongPt
        LongTotal = LongTotal + LongPt
    End If
    LargTotal = LargTotal + LargPt
   
Wend
End Sub

 

[JP.ROBERT]

Merci a tous pour vos réponses. Je test tout ça et je reviens vous dire ce qu'il en est.