[Writer] Renommer un fichier selon sélection
Publié : 07 nov. 2014 06:29
Bonjour,
Voici un fichier comprenant la macro originale d’alhazred
dont je m’étais servi comme exemple
dans le tutoriel Importer une macro d’un fichier exemple ; lanceurs
avec l’ancien fichier :[Writer]Renommer un document par le texte sélectionné
Afin de l’adapter à tous les systèmes Linux ou OS X, sans obliger les différents utilisateurs à passer par la modification
de la ligne url = ConvertToUrl("C :\" & sel. String & ".odt") valable pour WIN
ou /Users/Nomdel'utilisateur/Desktop/ pour OsX, etc.
les Voolontaires du Forum, Joel275, luky-luke, Piaf et Alain de La Chaume
ont apporté les modifications suggérées par alhazred.
Caractères autorisés en plus de l'alphabet classique (capitales et bas-de-casse) et des chiffres de 0 à 9 : âäàêëéèîïôöûüùç_-
Qu’ils soient tous vivement remerciés pour leur participation active.
Cordialement,
Voici un fichier comprenant la macro originale d’alhazred
Code : Tout sélectionner
REM ***** BASIC *****
Sub EnregistrerSousSelection()
Dim doc As Object, sel As Object, url As String, props()
doc = ThisComponent
sel = doc.currentSelection(0)
If Not sel. SupportsService("com.sun.star.text. TextRange") Then Exit Sub
'Indiquer ici le répertoire d’enregistrement
'On peut améliorer (même répertoire que le fichier original ou/et choix)
'et gérer les erreurs (sélection contenant un caractère interdit)
url = ConvertToUrl("C :\" & sel. String & ".odt")
doc. StoreAsUrl(url, props())
End Subdans le tutoriel Importer une macro d’un fichier exemple ; lanceurs
avec l’ancien fichier :[Writer]Renommer un document par le texte sélectionné
Afin de l’adapter à tous les systèmes Linux ou OS X, sans obliger les différents utilisateurs à passer par la modification
de la ligne url = ConvertToUrl("C :\" & sel. String & ".odt") valable pour WIN
ou /Users/Nomdel'utilisateur/Desktop/ pour OsX, etc.
les Voolontaires du Forum, Joel275, luky-luke, Piaf et Alain de La Chaume
ont apporté les modifications suggérées par alhazred.
Caractères autorisés en plus de l'alphabet classique (capitales et bas-de-casse) et des chiffres de 0 à 9 : âäàêëéèîïôöûüùç_-
Qu’ils soient tous vivement remerciés pour leur participation active.
Code : Tout sélectionner
REM ***** BASIC *****
option explicit
'———————————————————————————————————————————————————— v 2 du 7/11/2014
' Reprise et assemblage d'une partie des codes fournis
' par alhazred, joel275, Piaf, luky-luke...
'—————————————————————————————————————————————————————————————————————
sub enregistrerSelonSelection()
dim oDoc as object, oSelect as object, oSrv as object
dim urlRep as string, nomFic as string
dim t(), i as integer
dim carsOK as string, buf1 as string, buf2 as string, c as string
dim jdFilePicker as Object, jdFilePickerType(0) as Integer, MesFichiers() as String
oDoc = thisComponent
oSelect = oDoc.currentSelection(0)
if oSelect.string = "" then
msgBox "Effectuer d'abord une sélection !", 16, _
"Enregistrer doc selon selection "
exit sub
end if
' Chemin du dossier du document actif
t = split(oDoc.url, "/")
if uBound(t) > 0 then
i = uBound(t) -1
redim preserve t(i)
urlRep = join(t(), "/") & "/"
else ' 7/11/2014 : cas d'un doc non enregistré
oSrv = createUnoService("com.sun.star.util.PathSettings")
t = split(oSrv.Work,";")
urlRep = t(0)
if len(urlRep) then urlRep = urlRep & "/"
end if
' Dans le nom du fichier (sélection courante)
' - remplacer chaque espace par un tiret bas
buf1 = join( split(oSelect.string, " "), "_")
' - filtrer les caractères indésirables
carsOK = "abcdefghijklmnopqrstuvwxyz0123456789"
carsOK = carsOK & "_-âäàêëéèîïôöûüùç"
carsOK = carsOK & "œ§&£+$"
for i = 1 to len(buf1)
c = mid(buf1, i, 1)
if instr( carsOK, lcase(c) ) > 0 then nomFic = nomFic & c
next i
' Dialogue enregistrer sous... avec chemin et nom par défaut
jdFilePicker = CreateUnoService("com.sun.star.ui.dialogs.FilePicker")
' jdFilePicker = CreateUnoService("com.sun.star.ui.dialogs.OfficeFilePicker")
jdFilePickerType(0) = com.sun.star.ui.dialogs.TemplateDescription.FILESAVE_SIMPLE
jdFilePicker.initialize(jdFilePickerType())
jdFilePicker.DisplayDirectory = urlRep
jdFilePicker.Title = "Choisissez le répertoire d'enregistrement"
jdFilePicker.DefaultName = nomFic
jdFilePicker.AppendFilter("Documents ODF", "*.odt;*.ods")
jdFilePicker.CurrentFilter = "Documents ODF"
If jdFilePicker.Execute = com.sun.star.ui.dialogs.ExecutableDialogResults.OK Then
MesFichiers() = jdFilePicker.Files
ThisComponent.StoreAsUrl(MesFichiers(0), Array())
End If
jdFilePicker.Dispose()
end sub 