Dans le cadres de mon métier (facteur d’orgues), je dois dessiner des plans à l’échelle comportant un grand nombre de cercles ou de carrés, tous de tailles différentes. La détermination des cotes de ces carrés ou de ces cercles (qui sont des sections de tuyaux) se fait sans le moindre problème avec Calc. Mais en avoir automatiquement une représentation graphique que l’on puisse manipuler et placer sur un plan est évidemment extrêmement avantageux.
Depuis Calc, on sélectionne les valeurs, puis on lance la macro et un nouveau document Draw est créé contenant les cercles ou les rectangles (selon la sélection effectuée).
Pour être extrêmement simple, la macro laisse envisager une foultitude d’applications basées sur le même principe de stockage des valeurs dans Calc avec leur application graphique dans Draw. C’est ainsi que, sur ce même principe, on peut imaginer construire des types de graphiques qui n’existent pas dans Calc et qui, surtout, peuvent tracer des objets cotés à l’échelle de façon à être imprimés très précisément.
La macro :
Code : Tout sélectionner
' *** Mode d'emploi ***
' La macro doit s'exécuter sous Calc.
' Sélection des cellules.
' Étiquettes des noms de notes dans la colonne de gauche.
' Si deux colonnes sont sélectionnées au total (étiquettes + une colonne de données) alors, ce sont des cercles.
' Si trois colonnes sont sélectionnées au total (étiquettes + deux colonne de données) alors, ce sont des rectangles.
sub traceTuyaux()
Dim monDocument As Object
Dim propFich()
monDocument = ThisComponent
maFeuille = monDocument.CurrentController.ActiveSheet
maSelection = monDocument.getCurrentSelection()
mesLignes = maSelection.Rows.Count
mesColonnes = maSelection.Columns.Count
monDepartCol = maSelection.RangeAddress.StartColumn
monDepartLig = maSelection.RangeAddress.StartRow
Dim valeur(mesColonnes, mesLignes) As String
' Vérification de la sélection.
if ((mesColonnes < 2) or (mesColonnes > 3)) then ' Nombre de colonne inadapté.
MsgBox ("La sélection DOIT comporter 2 ou 3 colonnes." ,16)
Exit Sub
end if
' Lecture et mise en mémoire des cellules de la sélection.
For i = 0 to (mesLignes - 1)
valeur(0, i) = maFeuille.GetCellByPosition(monDepartCol, monDepartLig + i).String ' Étiquette.
For j = 1 to (mesColonnes - 1)
valRound = maFeuille.GetCellByPosition(monDepartCol + j, monDepartLig + i).Value ' Valeur numérique
valeur(j, i) = str((Cint(valRound * 10) / 10)) ' arrondie au dixième.
Next j
Next i
' Ouvre un nouveau document Draw.
monDessin = StarDesktop.LoadComponentFromURL("private:factory/sdraw", "_blank", 0, propFich)
Dim maPage As Object, maForme As Object, monTexte As Object
Dim dimensionsForme as New com.sun.star.awt.Size
Dim positionForme as New com.sun.star.awt.Point
maPage = monDessin.DrawPages(0) ' 0 est la première page.
x = 10 : y = 10 ' Position de départ des formes
' Traçage des formes.
For i = 0 to (mesLignes - 1)
largeur = val(valeur(1, i))
' Définition du type des formes.
if mesColonnes = 2 then ' Cercle.
hauteur = largeur
maForme = monDessin.createInstance("com.sun.star.drawing.EllipseShape")
maForme.CircleKind = com.sun.star.drawing.CircleKind.FULL
elseif mesColonnes = 3 then ' Rectangle
hauteur = val(valeur(2, i))
maForme = monDessin.createInstance("com.sun.star.drawing.RectangleShape")
end if
dimensionsForme.Width = largeur * 100 : dimensionsForme.Height = hauteur * 100 : maForme.Size = dimensionsForme
positionForme.x = x * 100 : positionForme.y = y * 100 : maForme.Position = positionForme
maForme.FillStyle = com.sun.star.drawing.FillStyle.NONE
maPage.add(maForme)
monTexte = maForme.Text
chaine = valeur(0, i)
' Remplacement de la chaîne « \n » par un saut de ligne chr(13).
while instr(chaine, "\n") > 0
posChaine = instr(chaine, "\n")
chaine = left(chaine, (posChaine - 1)) & chr(13) & right(chaine, len(chaine) - (posChaine + 1))
Wend
monTexte.String = chaine
monTexte.CharHeight = 10
x = x + 3 : y = y + 3 ' Décalage de la position des formes (en mm.) pour pouvoir plus aisément saisir les objets.
next i
end sub