Linuxing a écrit :Merci tiogran
de rien, j'apprends en même temps que toi des méthodes et fonctions dont je ne connaissais même pas l'existence.
Linuxing a écrit :Quant à l'ordre d'insertion des fichiers sur les pages (1 par page dans notre cas), le mieux est qu'il puisse se faire selon l'ordre d'affichage qui est de mise dans le navigateur de fichiers
et bien tu sais quoi.... j'ai réussi!!!; tu n'auras même plus besoin de renommer et les extensions ne seront plus un problème. Il faudra juste se gaffer dans un premier temps que seul des fichiers images soient dans le repertoire car sinon Basic n'arrivera pas à l'insérer dans le doc Draw.
La suite peut être pas demain mais mardi...
edit du 17.1
Hello,
Alors j'ai vraiment du neuf, comme je te le disais, je comptais changer de fusil d'épaule.
Voici donc dans les grandes lignes; les changements apportés.
1. Le document draw ne devra plus être dans le dossier où sont situées les images
2. Le dossier ne devra comporter que des images en essayant d'eviter le .bmp qui il me semble est un format propre à windows. Tu pourras donc y insérer .jpg, .jpeg et .png
3. Les fichiers images n'auront plus à suivre un dénomination particulière comme A1, A2 etc et peu importe leur extension ils seront pris en compte en suivant un ordre alphabétique semblable à l'ordre établi par le navigateur de dossier
4. Le document draw pourra être utilisé plusieurs fois; en quelque sorte il pourra être mis à jour.
5. La macro pourra être lançée depuis n'importe quel document .draw puisque je vais te montrer comment faire pour "héberger" la macro ailleurs que sur le document. Ce qui signifie que si tu créé un nouveau document .draw tu pourras utiliser la macro sans enregistrer la macro dans le document.
6. La procédure générale est modifiée
- tu ouvres un nouveau document draw
- tu executes la macro par un moyen que tu vas me définir parmi une liste de possiblités disponibles.
- se faisant, tu seras amené à sélectionner le dossier dans lequel sont contenus les images
- puis, tu seras amené à sélectionner un dossier de destination dans lequel sera créé la copie PDF.
7. A propos de la copie PDF
- j'ai modifié certains paramètres de création du pdf pour que le volet affiche automatiquement les miniatures des images avec le défilement souhaité tévitant cette manip' que tu pratique systématiquement.
- L'affichage de la feuille en fenêtre centrale est normalement à 100%
- La largeur de l'image sera automatiquement de 21 cm correspondant en fait au format A4 (21*29.7cm) en position portrait; ce qui signifie que si tu dois avoir du format paysage pour l'instant ce n'est pas encore possible. L'idéal est donc de disposer d'image en format A4 et en orientation portrait
- le nom de la copie PDF sera exactement le même que le document draw avec lequel tu auras lançé la macro mais avec l'extension .pdf pour nos amis windoziens.
>> rappel: chacunes des options possibles sur le visionneur de documents pdf est disponible par programmation si tu vois que tu actives trop souvent une option, il est surement plus interessant de la programmer
Voici donc la macro qui remplace en intégralité la précédente, tu peux la tester dans un premier temps dans le document via la méthode utilisée jusqu'à maintenant:
Code : Tout sélectionner
REM ***** BASIC *****
Option explicit
SUB Main_genererPdf
Dim doc, lesPages, unePage, page, fp, uneImg, lImage, gp as object
Dim UrlImg() as variant
Dim leDossImg_url, url_image, url_DossCopiePDF as string
Dim x ,y ,z ,a ,b ,xMax, nImg, nPages as integer
Dim props(0) as New com.sun.star.beans.PropertyValue
Dim logg as boolean
doc = thiscomponent
lesPages = doc.Drawpages
'logg = true
logg = false
fp = createunoservice("com.sun.star.ui.dialogs.FolderPicker")
With fp
.DisplayDirectory = convertToURL("/home/")
.Title = "Sélectionner un dossier contenant les images à transformer"
If .execute = com.sun.star.ui.dialogs.ExecutableDialogResults.OK then
leDossImg_url = .directory & "/"
End if
End with
UrlImg() = FilesName(leDossImg_url)
xMax = Ubound(UrlImg)
if logg then
Msgbox("le nombre d'images est: " & xMax+1)
end if
With lesPages
nPages = .getCount()
if logg then
Msgbox("le nombre de pages est: " & nPages)
end if
If nPages > 1 then
For each page in lesPages.ElementNames
lesPages.remove(lesPages.getbyname(page))
if logg then
Msgbox(page & " a été supprimée")
end if
Next page
End if
For y = 1 to xMax
.InsertNewByIndex(y)
if logg then
Msgbox("la Page " & y+1 & " a été crée")
end if
Next
End with
For z = 0 to xMax
if logg then
Msgbox("la Page " & z+1 & " est appellée")
end if
unePage = lesPages.getbyindex(z)
With unePage
.name = "Page " & z+1
nImg = .getCount()
If nImg > 0 then
For a=0 to nImg-1
.remove(.getbyindex(a))
Next
End if
End with
url_image = ConvertToURL(leDossImg_url & UrlImg(z))
gp = createUnoservice("com.sun.star.graphic.GraphicProvider")
props(0).Name = "URL"
props(0).Value = url_image
lImage = doc.createInstance("com.sun.star.drawing.GraphicObjectShape")
lImage.Graphic = gp.queryGraphic(props())
unePage.add(lImage)
New_resizeImageByWidth(lImage, 21000)
Next
With fp
.DisplayDirectory = convertToURL("/home/")
.Title = "Sélectionner un dossier de destination pour la copie PDF"
If .execute = com.sun.star.ui.dialogs.ExecutableDialogResults.OK then
url_DossCopiePDF = convertToURL(.directory & "/")
End if
End with
GenererUnPdfAvec(doc, url_DossCopiePDF)
END SUB
Function FilesName(leRepertoire as string)
dim f2 as string
dim x, xFiles as integer
xFiles = 0
f2 = Dir(leRepertoire & "*", 0)
Do while Len(f2) >0
f2 = Dir
xFiles = xFiles+1
Loop
Dim arrayF(xFiles-1) as variant
f2 = Dir(leRepertoire & "*", 0)
For x = 0 to xFiles-1
arrayF(x) = f2
f2 = Dir
Next
Filesname = New_BubbleSortList(arrayF())
End Function
Function New_BubbleSortList(ByVal SortList(),optional sort2ndValue as Boolean)
'This function bubble sorts an array of maximum 2 dimensions.
'The default sorting order is the first dimension
'Only if sort2ndValue is True the second dimension is the relevant for the sorting order
Dim s as Integer
Dim t as Integer
Dim i as Integer
Dim k as Integer
Dim dimensions as Integer
Dim sortvalue as Integer
Dim DisplayDummy
dimensions = 2
On Local Error Goto No2ndDim
k = Ubound(SortList(),2)
No2ndDim:
If Err <> 0 Then dimensions = 1
i = Ubound(SortList(),1)
If ismissing(sort2ndValue) then
sortvalue = 0
else
sortvalue = 1
end if
For s = 1 to i - 1
For t = 0 to i-s
Select Case dimensions
Case 1
If SortList(t) > SortList(t+1) Then
DisplayDummy = SortList(t)
SortList(t) = SortList(t+1)
SortList(t+1) = DisplayDummy
End If
Case 2
If SortList(t,sortvalue) > SortList(t+1,sortvalue) Then
For k = 0 to UBound(SortList(),2)
DisplayDummy = SortList(t,k)
SortList(t,k) = SortList(t+1,k)
SortList(t+1,k) = DisplayDummy
Next k
End If
End Select
Next t
Next s
New_BubbleSortList = SortList()
End Function
REM ***** BASIC *****
REM Ce travail est largement inspiré des travaux de M MARCELLY et M GODARD dans leur ouvrage "Programmation OpenOffice.org et LibreOffice"
Sub New_resizeImageByWidth(uneImage As Object, largeur As Long)
Dim imageInfo As Object, Proportion As Double, Taille1 As Object
imageInfo = uneImage.Graphic
Taille1 = imageInfo.SizePixel
Proportion = Taille1.Height / Taille1.Width
Taille1.Width = largeur ' largeur en 1/100 de mm
Taille1.Height = Taille1.Width * Proportion
uneImage.Size = Taille1
End Sub
SUB GenererUnPdfAvec(doc, url_dest)
Dim adresseDoc as string
Dim propsPDF as variant, propsFiltre as variant
propsFiltre = CreateProperties(Array(_
"PageRange", "",_
"UseTaggedPDF", True,_
"FormsType", 1,_
"ExportsNotes", True,_
"DisplayPDFDocumentTitle", False,_
"PDFViewSelection", 1,_
"UseLosslessCompression", True,_
"InitialView", 2,_
"PageLayout", 2,_
"Zoom", 100 ))
propsPDF = CreateProperties(Array(_
"FilterName", "draw_pdf_Export", "FilterData", propsFiltre() ))
adresseDoc = convertToURL(url_dest & getFileNameOnly(doc.URL) & ".pdf")
doc.storeToURL(adresseDoc, propsPDF())
Msgbox("fin de la copie!")
END SUB
Function CreateProperties(propList() As Variant) As Object
Dim n as long, x as long
n = UBound(propList)
if n < 0 then
CreateProperties = Array()
else
if (n and 1) = 0 then
MsgBox("Erreur : nombre impair d'arguments", 16, "CreateProperties")
else
Dim p(n\2) As New com.sun.star.beans.PropertyValue
for x = 0 to n\2
p(x).Name = propList(2*x)
p(x).Value = propList(2*x +1)
next
CreateProperties = p()
end if
end if
End Function
Function getFileNameOnly(URLPath As String) As String
Dim s As String, parts As Variant
s = getFullFileName(URLPath)
parts = split(s, ".")
if UBound(parts()) > 0 then
parts(UBound(parts())) = ""
s = join(parts, ".")
getFileNameOnly = Mid(s, 1, Len(s) -1)
else
getFileNameOnly = parts(0)
end if
End Function
Revenons à l'hébergement de la macro, je te demande de me faire confiance et de suivre mon conseil. Il est plus judicieux d'héberger la macro dans la bibliothèque réservée à Libre Office de sorte qu'elle soit disponible plus facilement via n'importe quel document.
Une fois ceci fait, tu vas pouvoir créer plusieurs sortes de raccourcis pour l'executer facilement.
ces facilités d'execution sont
- via une touche du clavier
- via un ajout dans un des menus de Libre Office Draw
- via l'ajout d'un bouton dans la barre d'outils "standard" ou n'importe quelle autre d'ailleurs.
il y en a peut etre d'autres mais là je ne m'en souviens pas...
Si tu me fais part de ta préférence, je peux t'apprendre comment faire.
Au final, je pense qu'il s'agit là d'un bon outil, il est robuste et je pense l'améliorer un peu en terme de robustesse car le moindre fichier qui n'est pas une image dans le dossier déclenchera une erreur et çà c'est pas terrible. Je suis assez content du résultat obtenu et j'espère que cela te plaira.
PS: j'ai devellopé cette version sur windows, normalement même avec linux ca devra faire. Je rappelle que bon nombre des fonctions ou sous programmes sont en totalité ou en partie issu du travail de membres de la communauté open office et comme il est de tradition dans l'open source je les en remercie.
Configuration personnelle du PC.
i7 4790k
radeon 7970 4g
16g ram 2133
ssd 120g (pour windaube)
hdd 1T (pour linux)
Os = dual boot windows 10 (l'escroc)
linux mint (l'insoumis)
Environnement MATE.
Une devise? en ce moment une se rappelle souvent à mon bon souvenir "Le problème EST la solution"
J'ai fait le test avec 3 pages sans leur extension (nommées : A1, A2, A3) puisque cette solution marcha (sans le centrage) 
