tu fais bien linuxing, tu fais bien voici la nouvelle macro!
Elle va régler ton problème de A100 etc
Code : Tout sélectionner
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 suspendu pour test
.name = UrlImg(z) 'activée pour test
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 = triAlpha(arrayF())
End Function
Sub New_resizeImageByWidth(uneImage As Object, largeur As Long)
'Fonction extraite du livre "programmation open office.org et libre office"
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
'Fonction extraite du livre "programmation open office.org et libre office"
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
'Fonction extraite du livre "programmation open office.org et libre office"
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
' renvoie le nom complet d'un fichier : Nom.Ext
Function getFullFileName(URLPath As String) As String
'Fonction extraite du livre "programmation open office.org et libre office"
Dim parts As Variant
parts = split(URLPath, "/")
getFullFileName = parts(UBound(parts())
End Function
function triAlpha(t1()) as variant
rem Fonction récupérée par Alain de la Chaume du forum ooO et modifiée par Hubert Lambert
dim t2() as variant
dim indexMaxi as long
dim cpt1 as long, cpt2 as long
dim varTmp as variant
indexMaxi = ubound(t1)
redim t2(indexMaxi)
t2 = t1
For cpt1 = 0 To indexMaxi - 1
For cpt2 = cpt1 + 1 To indexMaxi
If numberfromstring(t2(cpt1)) > numberfromstring(t2(cpt2)) Then
varTmp = t2(cpt1)
t2(cpt1) = t2(cpt2)
t2(cpt2) = varTmp
end if
Next cpt2
Next cpt1
triAlpha = t2()
end function
function numberfromstring(txt as string) as integer
Rem Fonction écrite par Hubert Lambert du forum ooO
dim s as object, search as object
dim start as long, end_ as long
s = createUnoService("com.sun.star.util.TextSearch")
dim opt as new com.sun.star.util.SearchOptions
opt.algorithmType = com.sun.star.util.SearchAlgorithms.REGEXP
opt.searchString = "[0-9]+"
s.setOptions(opt)
search = s.searchForward(txt, 0, len(txt))
start = search.startOffset(0)+1
end_ = search.endOffset(0) - search.startOffset(0)
numberfromstring = int(mid(txt, start, end_))
end function
La fonctionnalité tri a largement été revue grace à un membre du forum de libre office. Elle va régler les problèmes avec tes références actuelles. Mais je préfère te prevenir elle a ses limites: le tri ne fonctionnera pas sur une reference entremelant chiffres et lettres comme : "A110b52" mais j'y travaille!
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"