Re: [fr-users] Re: [Macro-Basic] génération de cours eleve à partir de fichier cours enseignant

Bonjour,
voila une version qui s'approche fortement de la version finale:

REM  *****  BASIC  *****

Sub Main

    repBase="/home/cemoi/Documents/bactma/Projet_01/" 'chemin à adapter

    ' boucle sur les repertoires et sous repertoires et traitement des
fichiers
    call boucleRepertoire(convertToUrl(repBase))

     msgBox "Fin du traitement"

End Sub

sub boucleRepertoire(sUrl)

    oSFA = createUnoService("com.sun.star.ucb.SimpleFileAccess")

    ListeFichiers = oSFA.getFolderContents(sUrl, True)

    for each sNom in ListeFichiers
         if oSFA.IsFolder(sNom) then
             call boucleRepertoire(sNom) ' appel recursif
         else
            if endWith(sNom, ".odt") then
                if not endWith(sNom,"_eleve.odt") then
                       if instr(sNom, "cours") > 0 then
                           call traiteFichier(sNom) ' on traite ce fichier
                       end if
                end if
            endif
        endif
    next sNom

end sub

function endWith(chaine, cherche)

    endWith = ( right(chaine, len(cherche)) = cherche)

end function

sub traiteFichier(urlFichier)

    ' ouverture
    doc = starDesktop.loadComponentFromUrl(urlFichier,"_blank",0, array())

    ' traitement des styles
    call RemplacerStylePartout2(doc)

    ' nom de fichier de sortie
    spliter = split(doc.url, ".") ' decoupe la chaine avec les points
    nb = ubound(spliter)
    spliter(nb-1) = spliter(nb-1)+"_eleve"

    spliter(nb)="pdf"
    newUrlPdf = join(spliter,".")

    spliter(nb)="odt"
    newUrlOdt = join(spliter,".")

    'enregistrement nouveau odt
    doc.storeAsUrl(newUrlOdt, array()) ' aucune option, array vide

    ' options de l'export pdf
    dim propsFiltre(0 to 0) as new com.sun.star.beans.PropertyValue
    propsFiltre(0).name = "IsSkipEmptyPages"
    propsFiltre(0).value = False

    dim prop(0 to 1) as new com.sun.star.beans.PropertyValue
    prop(0).name="FilterName"
    prop(0).value = "writer_pdf_Export"
    prop(1).name="FilterData"
    prop(1).value = propsFiltre()

    ' export pdf
    doc.storeToUrl(newUrlPdf, prop() )

    ' on ferme le fichier initial sans modification
    doc.close(false)

end sub

Sub RemplacerStylePartout2(MonDocument)

    Dim JeCherche As Object

    JeCherche = MonDocument.createReplaceDescriptor

    with JeCherche
      .SearchString  = "Texte eleve visible"
      .ReplaceString = "Texte eleve invisible"
      .SearchStyles = true
    end with

    MonDocument.replaceAll(JeCherche)

End Sub

Un grand merci à Laurent G qui m'a fortement aidé!! Même si il a trouvé que
j'avais fait quasi toutes les routines plus ou moins fonctionnelles ça du
lui prendre 5min chrono en main pour terminer la macro...

Cette macro fonctionne il me faut ajouter la fonctionnalité de ne traiter
que les fichiers qui ont étaient modifié le X dernières heures cela dans le
but de ne pas traiter tous les fichiers de l'arborescense à chaque
traitement.
Il me faut l'adapter pour pouvoir l'executer sur un serveur (sans interface
graphique sous linux)
Âpres ça je documenterai un peu plus la macro avec des commentaires dedans
pour qu'elle puisse être réutilisés.


Merci beaucoup à tous ceux qui m'ont aidé!

Le 7 juin 2015 17:06, Cemoi Cemoi <matlane2014@gmail.com> a écrit :

> Bonjour,
> je m'excuse si je ne suis pas trop en ligne en ce moment... merci beaucoup
> à vous deux, il y a peu de monde capable ou prenant le temps d'étudier une
> telle demande qui est quand même un poil complexe...
>
>
> Un exemple de l'utilisation de SimpleFileAccessqui se trouve à la page 155
> du livre programmer avec openoffice.org 2, il compte les repertoires et
> le fichiers:
>
> Option Explicit
>
> ' exemple : compter le nombre de sous-répertoires et le nombre total de
> fichiers
> Private d as long, f as long
>
> Sub Main
> Dim depart As String
> d= 0
> f = 0
> depart = ConvertToURL("C:\Docs OpenOffice\") 'adapter le chemin en
> fonction du besoin
> explorerDossier(depart)
> MsgBox(d & " répertoires,   " & f & " fichiers")
> End Sub
>
>
> Sub explorerDossier(ByVal repEnCours As String)
> Dim item As String
> Dim ucb As Object, dc As Variant
>
> ucb = createUnoService("com.sun.star.ucb.SimpleFileAccess")
> On Error GoTo accesInterdit
> dc = ucb.getFolderContents(repEnCours, True)
> ' ici on obtient un tableau des url complètes
> ' de chaque fichier et chaque répertoire du répertoire en cours
> ' mais dans le désordre !
> for each item in dc
>   if ucb.IsFolder(item)  then ' traitement pour chaque sous-répertoire
>     d = d+1 ' exemple : compter les sous-répertoires
>     explorerDossier(item) ' récursion
>   else ' traitement pour chaque fichier
>     f = f+1 ' exemple : compter les fichiers
>   end if
> next
> GoTo Exit1
>
> accesInterdit:
> Resume Exit1
> Exit1:
> On Error GoTo 0
> End Sub
> J'espére pouvoir travailler dessus cette semaine et vous faire un retour.
> Je documenterai un peu la macro quand elle sera fonctionnelle dans
> l'optique qu'elle puisse être utilisable par le plus grand nombre.
>
> Best regard :)
>
> Le 1 juin 2015 18:48, pierre-yves samyn <pierre-yves.samyn@laposte.net> a
> écrit :
>
> > Bonjour Laurent
> >
> > Surtout merci à toi de qui j'ai tant appris même si tu ne le sais pas
> > (projet ancien...), et l'occasion de remercier aussi Andrew Pitonyak &
> > Bernard Marcelly (livre et Xray).
> >
> > Pierre-Yves
> >
> >
> >
> > --
> > View this message in context:
> > http://nabble.documentfoundation.org/Macro-Basic-generation-de-cours-eleve-a-partir-de-fichier-cours-enseignant-tp4149242p4150227.html
> > Sent from the Users mailing list archive at Nabble.com.
> >
> > --
> > Envoyez un mail à users+unsubscribe@fr.libreoffice.org pour savoir
> > comment vous désinscrire
> > Les archives de la liste sont disponibles à
> > http://listarchives.libreoffice.org/fr/users/
> > Tous les messages envoyés sur cette liste seront archivés publiquement et
> > ne pourront pas être supprimés

-- 
Envoyez un mail à users+unsubscribe@fr.libreoffice.org pour savoir comment vous désinscrire
Les archives de la liste sont disponibles à http://listarchives.libreoffice.org/fr/users/
Tous les messages envoyés sur cette liste seront archivés publiquement et ne pourront pas être 
supprimés