Piloter OpenOffice depuis Excel

SilkyRoad

Ce tutoriel montre comment manipuler des fichiers OpenOffice en VBA Excel.
Le principe de fonctionnement est identique en VB6.

Tous les exemples ont été testés avec Excel2002, OOo2.0.1 & WinXP. ♪

- Titre : Piloter OpenOffice depuis Excel

- Auteur : SilkyRoad

- Parution : 9 octobre 2006

- Licence : Ce document est issu de http://www.developpez.com et reste la propriété exclusive de son auteur. La copie, modification et/ou distribution par quelque moyen que ce soit est soumise à l'obtention préalable de l'autorisation de l'auteur.

Sommaire

- I. Préambule

- II. Manipuler les fichiers OpenOffice

- II-A. Ouvrir un fichier Writer et y ajouter des données à la suite de la dernière ligne

- II-B. Coller une plage de cellules Excel dans un nouveau document Writer, puis sauvegarder le document

- II-C. La Fonction de conversion ConvertToURL

- II-D. Ouvrir un document OpenOffice protégé par mot de passe

- II-E. Modifier l'entête et le pied de page d'un document OOo

- II-F. Fermer toutes les fenêtres OpenOffice sans sauvegarde

- II-G. Lister les documents OpenOffice ouverts

- III. Utiliser les filtres de conversion OpenOffice

- III-A. Lister les filtres de conversion disponibles

- III-B. Sauvegarder un fichier CALC et créer une copie au format .xls

- III-C. Utiliser le convertisseur PDF

- IV. Piloter une base OpenOffice (.ODB) depuis Excel

- IV-A. Effectuer une requête dans une base

- IV-B. Ajouter un enregistrement dans une table OOo

- IV-C. Supprimer un enregistrement dans une table OOo

- IV-D. Mettre à jour les enregistrements dans une table OOo

- IV-E. Ajouter une nouvelle table dans une base OpenOffice

- V. Déclencher une macro OpenOffice depuis Excel

- VI. Piloter un publipostage Writer depuis VB6/VBA

- VI-A. Lancer un publipostage pour l'ensemble des enregistrements

- VI-B. Lancer un publipostage en appliquant un filtre sur la valeur d'un champ

- VII. Récupérer les macros d'un classeur Excel endommagé

- VIII. Conclusion

- IX. Remerciements

I - Préambule

OpenOffice.org (aussi appelé OOo) est une suite bureautique libre, constituée :

d'un traitement de texte (.odt);

d'un tableur (.ods);

d'un module de présentations (.odp);

d'un module de dessins (.odg);

d'un module pour les bases de données (.odb).

Vous trouverez une description détaillée dans ce lien, ainsi que l'application en téléchargement :

http://fr.openoffice.org/

Si vous recherchez des informations pour comparer les suites bureautiques gratuites et commerciales :

Consultez le tutoriel de Netah25.

Si vous débutez dans l'utilisation des bases de données OpenOffice :

Consultez le tutoriel de Cyril Beaussier.

Il n'existe pas de bibliothèque pour piloter OOo depuis VB et VBA, mais il est possible d'utiliser les API d'OpenOffice pour manipuler les fichiers : c'est l'objet de ce tutoriel.

Nota pour la rédaction des macros

Il est important de savoir que certaines syntaxes sont sensibles à la casse. Il est par exemple nécessaire de préciser le D majuscule pour « Desktop » :

Vb

CreateInstance("com.sun.star.frame.Desktop")

II - Manipuler les fichiers OpenOffice

Ce chapitre présente quelques exemples de pilotage depuis Excel.

II-A - Ouvrir un fichier Writer et y ajouter des données à la suite de la dernière ligne

Vb

Sub ModifierFichierOpenOffice()
'macro testée avec Excel2002 et OOo 2.0.1
Dim serviceManager As Object, oText As Object, oCursor As Object
Dim Desktop As Object, Document As Object
Dim Fichier As String
Dim args()

'Transformation du chemin pour l'ouvrir au format URL
Fichier = "file:///" & ThisWorkbook.Path & "/test.odt"
Fichier = Replace(Fichier, "\", "/")
'-------------

'Création d'une instance OpenOffice
Set serviceManager = CreateObject("com.sun.star.serviceManager")
Set Desktop = serviceManager.createInstance("com.sun.star.frame.Desktop")

'Ouverture du fichier
Set Document = Desktop.loadComponentFromURL(Fichier, "_blank", 0, args)
Set oText = Document.getText()

'Création du curseur d'écriture
Set oCursor = oText.createTextCursor

'Déplace le curseur a la fin , sans sélection(False)
oCursor.gotoEnd (False)

'insère du texte et un saut de ligne a l'emplacement du curseur , Sans sélection(False)
oText.insertString oCursor, "Les nouvelles informations" & vbLf, False
End Sub

II-B - Coller une plage de cellules Excel dans un nouveau document Writer, puis sauvegarder le document

Vb

Sub creerNouveauDocumentWriter()
Dim oServiceManager As Object, oDispatcher As Object
Dim Desktop As Object, Document As Object
Dim args()
Dim Chemin As String, Fichier As String
Dim T As Date

'Copie de la plage de cellules dans Excel
Range("A1:A5").Copy

'Création d'une instance OpenOffice
Set oServiceManager = CreateObject("com.sun.star.serviceManager")
Set Desktop = oServiceManager.createInstance("com.sun.star.frame.Desktop")

'Création d'un nouveau document Writer
Set Document = Desktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, args)

'Collage dans OpenOffice
Set oDispatcher = oServiceManager.createInstance("com.sun.star.frame.DispatchHelper")
oDispatcher.executeDispatch Document.currentController.Frame, ".uno:Paste", "", 0, Array()

'Conversion de l'emplacement de sauvegarde au format URL
Chemin = Replace(ThisWorkbook.Path, "\", "/")
Fichier = "file:///" & Chemin & "/essai.odt"
'------

'Sauvegarde du nouveau document Writer
Document.storeAsURL Fichier, args()
DoEvents

'--------
'ajoute une temporisation de 2 secondes pour empêcher que le fichier
'ne se ferme avant la fin de la création
T = Timer + 2: Do Until Timer > T: DoEvents: Loop
'--------

'Fermeture du fichier
'L'argument True indique que les modifications vont être sauvegardées à la fermeture
Document.Close (True)
End Sub

II-C - La Fonction de conversion ConvertToURL

Comme vous avez pu le constater dans les exemples précédents, le chemin des fichiers est indiqué au format URL.

file:///C:/Documents And Settings/Repertoire/le Document.odt

OpenOffice possède une fonction spécifique qui permet cette conversion: ConvertToURL.

Cette fonction n'est pas disponible depuis VB/VBA mais vous pouvez créer une fonction personnelle en remplacement.
(Un exemple dans Excel) :

Vb

Sub Test()
Dim serviceManager As Object, Desktop As Object, Document As Object
Dim Fichier As String
Dim args()

'Création d'une instance OpenOffice
Set serviceManager = CreateObject("com.sun.star.serviceManager")
Set Desktop = serviceManager.createInstance("com.sun.star.frame.Desktop")

'Appel fonction de conversion
Fichier = ConvertToURL("C:\Documents and Settings\michel\le document.odt")

'Ouverture du fichier
Set Document = Desktop.loadComponentFromURL(Fichier, "_blank", 0, args)
End Sub

Function ConvertToURL(Fichier As String)
'fonction de conversion  au format URL
Dim Cible As String
Cible = Fichier
Cible = Replace(Cible, "\", "/")
ConvertToURL = "file:///" & Cible
End Function

II-D - Ouvrir un document OpenOffice protégé par mot de passe

Vb

Sub ouvrirDocOpenOfficeProtegeParPassword()
Dim serviceManager As Object, Desktop As Object, Document As Object
Dim Fichier As String
Dim Args(0) As Object

'Transformation du chemin pour l'ouvrir au format URL
Fichier = "file:///C:/leDocumentProtege.odt"
Fichier = Replace(Fichier, "\", "/")
'-------------

'Création d'une instance OpenOffice
Set serviceManager = CreateObject("com.sun.star.ServiceManager")
Set Desktop = serviceManager.createInstance("com.sun.star.frame.Desktop")

'Tableau pour les paramètres du mot de passe
Set Args(0) = serviceManager.Bridge_getStruct("com.sun.star.beans.PropertyValue")

'Arguments OpenOffice pour indiquer le mot de passe
Args(0).Name = "Password" 'nom de l'argument
Args(0).Value = "testMdP" 'valeur de l'argument

On Error GoTo Fin
'Ouverture du fichier
Set Document = Desktop.loadComponentFromURL(Fichier, "_blank", 0, Args())

Exit Sub

Fin:
If Err.Number = 424 Then MsgBox "Vérifiez le mot de passe indiqué dans votre procédure."
End Sub

Remarques

La procédure renvoie une Erreur 424 « Objet Requis » , si le mot de passe est erroné ou non précisé.

L'indication d'un mot de passe dans la macro alors que le classeur n'est pas protégé , ne renvoie pas d'erreur.

II-E - Modifier l'entête et le pied de page d'un document OOo

Vb

Sub modificationEnteteTableur_OpenOffice()
Dim serviceManager As Object
Dim Desktop As Object, Document As Object
Dim Chemin As String, Fichier As String
Dim args()
Dim Feuille As Object, leStyle As Object, Entete As Object, piedPage As Object
Dim oText As Object, Curseur As Object, leChamp As Object

'Transformation du chemin pour l'ouvrir au format URL
Chemin = "file:///" & ThisWorkbook.Path & "\OOoClasseur.ods"
Fichier = Replace(Chemin, "\", "/")

'Création d'une instance OpenOffice
Set serviceManager = CreateObject("com.sun.star.serviceManager")
Set Desktop = serviceManager.createInstance("com.sun.star.frame.Desktop")

'Ouverture du document Calc
Set Document = Desktop.loadComponentFromURL(Fichier, "_blank", 0, args)

'Mise en variable de la feuille active
Set Feuille = Document.CurrentController.getActiveSheet

Set leStyle = Document.StyleFamilies.getByName("PageStyles").getByName(Feuille.PageStyle)

'Acces a l'entete de page
Set Entete = leStyle.RightPageHeaderContent
Set oText = Entete.CenterText
oText.setString ("") 'Efface les données existante dans l'entête de page

Set Curseur = oText.CreateTextCursor()
Curseur.CharWeight = 150 'Gras(indiquez la valeur 100 pour un format normal)
Curseur.CharPosture = 0 '(indiquez la valeur 2 pour afficher le texte en italique)
Curseur.CharFontName = "Arial"
Curseur.CharHeight = "12" 'taille caractères
oText.insertString Curseur, "Les données à insérer", False
'-------------------------------------------------------

'pour insérer le Numero de page en pied de page
Set piedPage = leStyle.RightPageFooterContent
Set oText = piedPage.CenterText
oText.setString ("") 'RAZ entete
Set Curseur = oText.CreateTextCursor()

'Création d'un champ "PageNumber"
Set leChamp = Document.createInstance("com.sun.star.text.TextField.PageNumber")
oText.insertTextContent Curseur, leChamp, False
'-------------------------------------------------------

leStyle.RightPageHeaderContent = Entete
leStyle.RightPageFooterContent = piedPage
End Sub

Pour voir le résultat dans le fichier OpenOffice :
Menu Editer ;
Option « Entête et pied de page ».

II-F - Fermer toutes les fenêtres OpenOffice sans sauvegarde

Vb

Sub fermerToutesLesFenetresOOoSansSauvegarde()
Dim serviceManager As Object, Desktop As Object
Dim i As Byte

'Création d'une instance OpenOffice
Set serviceManager = CreateObject("com.sun.star.serviceManager")
Set Desktop = serviceManager.createInstance("com.sun.star.frame.Desktop")

'Boucle sur les fenêtres OpenOffice ouvertes
For i = 1 To Desktop.Frames.getCount 'compte le nombre de fenêtres OOo ouvertes
Desktop.getFrames.getByIndex(0).Close (False)
Next i
End Sub

II-G - Lister les documents OpenOffice ouverts

Vb

Sub listeDocumentsOpenOfficeOuverts()
Dim oComponents As Object, Cible As Object
Dim Desktop As Object, oServiceManager As Object, oComponent As Object
Dim Nombre As Byte
Dim listeDoc As String, leFichier As String

On Error Resume Next

'Création Instance OpenOffice
Set oServiceManager = CreateObject("com.sun.star.serviceManager")
Set Desktop = oServiceManager.createInstance("com.sun.star.frame.Desktop")

'Permet l'accès aux composants chargés
Set oComponents = Desktop.getComponents()

'Création d'une collection
Set Cible = oComponents.createEnumeration()

'Boucle sur les éléments de la collection
Do While Cible.hasMoreElements()
Set oComponent = Cible.nextElement()
leFichier = oComponent.getLocation()
If Err.Number = 0 Then
If leFichier = "" Then _
leFichier = "Document ( " & typeDoc(oComponent) & " ) non enregistré"

listeDoc = listeDoc & leFichier & vbLf
Nombre = Nombre + 1
End If
Err.Number = 0
Loop

MsgBox "Nombre de documents OpenOffice ouverts : " & Nombre & vbLf & vbLf & listeDoc
End Sub

Function typeDoc(Obj As Object) As String
'
'adapté d'une procédure OpenOffice de Laurent Godard
'
If Obj.supportsService("com.sun.star.text.TextDocument") = True Then _
typeDoc = "Writer"
If Obj.supportsService("com.sun.star.sheet.SpreadsheetDocument") = True Then _
typeDoc = "Calc"

If Obj.supportsService("com.sun.star.presentation.PresentationDocument") = True Then
typeDoc = "Impress"
Exit Function
End If

If Obj.supportsService("com.sun.star.drawing.DrawingDocument") = True Then _
typeDoc = "Draw"
End Function

III - Utiliser les filtres de conversion OpenOffice

Pour moi, un des points forts d'OpenOffice réside dans la liste des filtres de conversion disponibles.
Ces filtres permettent de créer un document dans OpenOffice et de le sauvegarder dans un format compatible vers une autre application (par exemple Microsoft Office).

Voici trois exemples d'utilisation.

III-A - Lister les filtres de conversion disponibles

Vb

Sub ListerNomsFiltresConversion()
Dim serviceManager As Object, filtresFact As Object
Dim nomFiltres As Variant
Dim i As Integer

'Creation instance OpenOffice
Set serviceManager = CreateObject("com.sun.star.serviceManager")
Set filtresFact = serviceManager.createInstance("com.sun.star.document.FilterFactory")

' Liste le nom des filtres
nomFiltres = filtresFact.getElementNames()
For i = LBound(nomFiltres) To UBound(nomFiltres)
Debug.Print nomFiltres(i)
Next
End Sub

III-B - Sauvegarder un fichier CALC et créer une copie au format .xls

Cette procédure :
crée un nouveau fichier OpenOffice Calc ;
y transfère les données de la plage A1:A10 (du classeur Excel contenant cette macro) ;
sauvegarde le fichier au format .ods ;
puis fait une copie de sauvegarde du fichier ODS au format Excel.

Vb

Sub Sauvegardes_OOo_XLs()
Dim Args(), Args2(0)
Dim oServ As Object, oDesk As Object, oSheet As Object, Doc As Object
Dim Donnees As String
Dim i As Byte

'Création d'une instance OpenOffice
Set oServ = CreateObject("com.sun.star.ServiceManager")
Set oDesk = oServ.createInstance("com.sun.star.frame.Desktop")

'Création d'un fichier Calc
Set Doc = oDesk.loadComponentFromURL("private:factory/scalc", "_blank", 0, Args)
Set oSheet = Doc.getSheets().getByIndex(0)

'Boucle sur la plage de cellules Excel A1:A10 pour un transfert dans Calc
For i = 0 To 9
Donnees = Cells(i + 1, 1)
'remarque:
'Dans OOo les cellules sont indiquées ainsi :
'getCellByPosition(NumeroColonne, NumeroLigne)
'L'index de la 1ere ligne et de la 1ere colonne ont la valeur 0
oSheet.getCellByPosition(0, i).SetString (Donnees)
Next i

'Sauvegarde au format standard OpenOffice
Doc.StoreAsURL "file:///C:/monClasseur.ods", Args

'-----------
'Crée une copie du document OpenOffice au format Excel
Set Args2(0) = oServ.Bridge_GetStruct("com.sun.star.beans.PropertyValue")
Args2(0).Name = "FilterName"
Args2(0).Value = "MS Excel 97"
Doc.StoreToURL "file:///C:/monClasseur.xls", Args2
DoEvents
'-----------

'Fermeture du document en sauvegardant les modifications
Doc.Close (True)
End Sub

III-C - Utiliser le convertisseur PDF

Cette procédure :
ouvre un document Word dans OpenOffice (module Writer) ;
convertit le document au format PDF ;
referme le document.

Vb

Sub convertirDocumentWord_En_PDF()
Dim serviceManager As Object, Desktop As Object, Fichier As Object
Dim TabOuv() As Variant
Dim Args(1) As Object
Dim T As Date

'Création instance OpenOffice
Set serviceManager = CreateObject("com.sun.star.ServiceManager")
Set Desktop = serviceManager.createInstance("com.sun.star.frame.Desktop")

'Ouverture du fichier Word
Set Fichier = _
Desktop.loadComponentFromURL("file:///C:/documentWord.doc", "_blank", 0, TabOuv())

'Tableau pour les paramètres de conversion
Set Args(0) = serviceManager.Bridge_getStruct("com.sun.star.beans.PropertyValue")

'Arguments OpenOffice pour convertir un document Writer en PDF
Args(0).Name = "FilterName" 'nom de l'argument
Args(0).Value = "writer_pdf_Export" 'valeur de l'argument

'Sauvegarde du fichier PDF
Fichier.storeToURL "file:///C:/copieDocumentWord.pdf", Args()
DoEvents

'--------
'ajoute une temporisation de deux secondes pour empêcher que le fichier
'ne se ferme avant la fin de la conversion
T = Timer + 2: Do Until Timer > T: DoEvents: Loop
'--------

'Fermeture du fichier
Fichier.Dispose
End Sub

IV - Piloter une base OpenOffice (.ODB) depuis Excel

Depuis sa version 2, OOo dispose d'un module base de données intégré.
Il est possible de manipuler ces bases en VB/VBA.

IV-A - Effectuer une requête dans une base

Un exemple pour effectuer une requête dans la base de données « Bibliography » (base démo fournie dans le pack d'installation OpenOffice).

Vb

Sub requeteBase_ODB()
Dim oDB As Object, oBase As Object
Dim oStatement As Object
Dim rSQL As String
Dim oRequete As Object
Dim oServiceManager As Object, CreateUnoService As Object
Dim i As Integer

'Création instance OpenOffice
Set oServiceManager = CreateObject("com.sun.star.ServiceManager")
Set CreateUnoService = _
oServiceManager.createInstance("com.sun.star.sdb.DatabaseContext")

'Indique le nom de la base
Set oDB = CreateUnoService.getByName("Bibliography")

'Connection
Set oBase = oDB.getConnection("", "")
Set oStatement = oBase.createStatement

'Création requète
rSQL = "SELECT ""Identifier"",""Publisher"",""ISBN"" FROM ""biblio"" " & _
"WHERE ""Author""='Böhm, Franz'"
Set oRequete = oStatement.ExecuteQuery(rSQL)

'Affichage du résultat de la requête dans les cellules Excel
If Not IsNull(oRequete) Then
While oRequete.Next
i = i + 1
Cells(i, 1) = oRequete.getString(1)
Cells(i, 2) = oRequete.getString(2)
Cells(i, 3) = oRequete.getString(3)
Wend
End If

oRequete.Close
oStatement.Close
End Sub

Remarque 1

Si la base est protégée par un mot de passe vous devez remplacer la ligne

Vb

Set oBase = oDB.getConnection("", "")

par

Vb

Set oBase = oDB.getConnection("Login", "MotDePasse")

Remarque 2

Le nom des champs et des tables doit être encadré par des doubles guillemets :

Vb

rSQL = "SELECT ""Champ1"" FROM ""maTable"""

Remarque 3

Si la base n'est pas enregistrée, vous devez utiliser cette syntaxe :

Vb

Dim Fichier As String
Fichier = "file:///C:/Documents and Settings/michel/dossier/OOoBase.odb"

'Indique le nom de la base pour la connexion
Set oDB = CreateUnoService.getByName(Fichier)

Une base est dite enregistrée lorsque vous pouvez la visualiser en utilisant le menu Afficher/Sources de données (ou par la touche raccourci F4).

Pour enregistrer une base :
Menu Outils ;
Options ;
Sélectionnez « OpenOffice.org Base » dans l'arborescence ;
Double cliquez sur « Bases de données » ;
Cliquez sur le bouton « Nouveau » ;
Utilisez le bouton « Parcourir » pour rechercher la base sur le disque ;
Puis validez en cliquant sur OK dans toutes les boîtes de dialogue.

IV-B - Ajouter un enregistrement dans une table OOo

Cet exemple ajoute un enregistrement dans la table « maTable » d'une base enregistrée nommée OooBase :

Vb

Sub ajoutEnregistrement_Base_ODB()
Dim oDB As Object, oBase As Object
Dim oStatement As Object
Dim rSQL As String
Dim oRequete As Object
Dim oServiceManager As Object, CreateUnoService As Object

'Création instance OpenOffice
Set oServiceManager = CreateObject("com.sun.star.ServiceManager")
Set CreateUnoService = _
oServiceManager.createInstance("com.sun.star.sdb.DatabaseContext")

'Indique le nom de la base pour la connexion
Set oDB = CreateUnoService.getByName("OOoBase")

'Connection
Set oBase = oDB.getConnection("", "")
Set oStatement = oBase.createStatement

'Ajoute un enregistrement
rSQL = _
"INSERT INTO ""maTable"" (""ChampTexte"", ""ChampNum"") Values('Nouvelle ligne', 12345)"
Set oRequete = oStatement.ExecuteQuery(rSQL)

oRequete.Close
oStatement.Close
End Sub

Remarque

En fonction de la version d'OpenOffice, il faut parfois remplacer :

Vb

Set oRequete = oStatement.ExecuteQuery(rSQL)

par

Vb

Set oRequete = oStatement.ExecuteUpdate(rSQL)

IV-C - Supprimer un enregistrement dans une table OOo

Vb

'Supprime les enregistrements si le Champ2 contient la valeur 12345
rSQL = "DELETE FROM ""maTable"" WHERE ""Champ2""=12345 "
Set oRequete = oStatement.executeQuery(rSQL)

IV-D - Mettre à jour les enregistrements dans une table OOo

Vb

'Mise à jour d'enregistrements
'Insère le mot "Cloture" dans le Champ1 si le Champ2 contient la valeur 10
rSQL = "UPDATE ""maTable"" SET ""Champ1""='Cloture' WHERE ""Champ2"" = 10"
Set oRequete = oStatement.executeQuery(rSQL)

IV-E - Ajouter une nouvelle table dans une base OpenOffice

Vb

Sub creationTable_Dans_Base_ODB()
Dim oDB As Object, oBase As Object
Dim oServiceManager As Object, CreateUnoService As Object
Dim NouvelleTable As Object, CollectionTables As Object, NouveauChamp As Object

'Création instance OpenOffice
Set oServiceManager = CreateObject("com.sun.star.ServiceManager")
Set CreateUnoService = _
oServiceManager.createInstance("com.sun.star.sdb.DatabaseContext")

'indique le nom de la base
Set oDB = CreateUnoService.getByName("OOoBase")

'Connection
Set oBase = oDB.getConnection("", "")

'------ creation nouvelle table-----------
Set CollectionTables = oBase.Tables

Set NouvelleTable = CollectionTables.createDataDescriptor
NouvelleTable.Name = "gestionStock" 'nom de la nouvelle table

'Description 1er champ
Set NouveauChamp = NouvelleTable.Columns.createDataDescriptor
NouveauChamp.Name = "NomProduit" 'nom champ
NouveauChamp.Type = 1 'champ type texte
NouveauChamp.Precision = 200
NouvelleTable.Columns.appendByDescriptor NouveauChamp 'ajout du champ

'Description 2e champ
Set NouveauChamp = NouvelleTable.Columns.createDataDescriptor
NouveauChamp.Name = "Stock" 'nom champ
NouveauChamp.Type = 2 'champ type nombre
NouveauChamp.Precision = 10
NouvelleTable.Columns.appendByDescriptor NouveauChamp

'insertion de la nouvelle table
CollectionTables.appendByDescriptor NouvelleTable
'----------------------------------------

End Sub

V - Déclencher une macro OpenOffice depuis Excel

Cette procédure permet de déclencher la macro d'un document OpenOffice ouvert et non sauvegardé, nommé « Sans nom1 ».

Vb

oURL.Complete = "macro://Sans nom1/Standard.Module1.nomMacroOOo"

La macro OpenOffice est nommée « nomMacroOOo » et située dans le « Module1 »

Vb

Private Sub Command1_Click()
Dim oServiceManager As Object, oURL As Object
Dim oTrans As Object
Dim Desktop As Object, Args(1) As Object, oDisp As Object

Set oServiceManager = CreateObject("com.sun.star.ServiceManager")
Set oURL = oServiceManager.Bridge_getStruct("com.sun.star.util.URL")
oURL.Complete = "macro://Sans nom1/Standard.Module1.nomMacroOOo"

Set oTrans = oServiceManager.createInstance("com.sun.star.util.URLTransformer")
oTrans.parseStrict oURL

Set Desktop = oServiceManager.createInstance("com.sun.star.frame.Desktop")
Set oDisp = Desktop.queryDispatch(oURL, "_self", 0)
oDisp.Dispatch oURL, Args()
End Sub

Si le document OpenOffice est déjà sauvegardé (OOoTableurTest.ods par exemple), vous pouvez utiliser ce type de syntaxe :

Vb

oURL.Complete = "macro://OOoTableurTest/Standard.Module1.nomMacroOOo"

Remarque
il ne faut pas indiquer l'extension du document ( .ods , .odt …)

Attention :

la procédure est sensible aux majuscules et aux minuscules.

Si la procédure est stockée dans « Mes macros » (macros personnelles), vous pouvez utiliser :

Vb

oURL.Complete = "macro:///Standard.Module1.nomMacroOOo"

VI - Piloter un publipostage Writer depuis VB6/VBA

Ce chapitre propose deux exemples pour lancer des publipostages OpenOffice depuis VB/VBA.

VI-A - Lancer un publipostage pour l'ensemble des enregistrements

Description des arguments de la procédure « Publipostage » :

nomBase : nom de la base intégrée contenant les enregistrements ;

docPrincipal : chemin et Nom du document principal de publipostage(Writer) ;

CmdType : type de données 0=Table 1=Link 2=Query ;

Cmd : nom de la table contenant les enregistrements ;

OutType : détermine la destination du publipostage
1= publipostage vers l'imprimante
2= publipostage vers des fichiers
L'option 2 permet de créer un fichier de fusion pour chaque enregistrement ;

CheminFichierFusion :
(Argument optionnel à utiliser uniquement si OutType = 2)
Correspond au répertoire de sauvegarde pour les nouveaux fichiers créés ;

NomFichierFusion :
(Argument optionnel à utiliser uniquement si OutType = 2)
Définit le nom par défaut pour chaque nouveau fichier.
Si par exemple vous indiquez NomFichierFusion_, le 1er fichier sera nommé ; NomFichierFusion_0, le 2e NomFichierFusion_1 …etc.

Consultez l'aide OpenOffice pour obtenir plus de détails.

L'exemple ci-dessous lance une fusion (en mode impression) pour l'ensemble des enregistrements.

Vb

Option Explicit

Dim oServiceManager As Object

Sub Test()
Set oServiceManager = CreateObject("com.sun.star.ServiceManager")

'----- exemple publipostage vers imprimante -------
Publipostage _
"OOoBase", _
"file:///C:/repertoire/monDocument.odt", _
0, _
"maTable", _
1

'----- exemple publipostage dans fichiers --------
'Publipostage _
"OOoBase", _
"file:///C:/repertoire/monDocument.odt", _
0, _
"maTable", _
2, _
"file:///C:/repertoire/", _
"docFusion_"
End Sub

Private Sub Publipostage(nomBase As String, docPrincipal As String, _
CmdType As Integer, Cmd As String, OutType As Integer, _
Optional CheminFichierFusion As String, Optional NomFichierFusion As String)
Dim Args() As Object
Dim objMailMerge As Object

If OutType = 2 Then
ReDim Args(6)
Else
ReDim Args(4)
End If

Set objMailMerge = _
oServiceManager.createInstance("com.sun.star.text.MailMerge")

Set Args(0) = OOoNamedValue("DataSourceName", nomBase)
Set Args(1) = OOoNamedValue("DocumentURL", docPrincipal)
Set Args(2) = OOoNamedValue("CommandType", CmdType)
Set Args(3) = OOoNamedValue("Command", Cmd)
Set Args(4) = OOoNamedValue("OutputType", OutType)

If OutType = 2 Then
Set Args(5) = OOoNamedValue("OutputURL", CheminFichierFusion)
Set Args(6) = OOoNamedValue("FileNamePrefix", NomFichierFusion)
End If

objMailMerge.Execute Args()
End Sub

Function OOoNamedValue(cName As String, uValue As Variant) As Object
'Fonction de DannyB
'http://www.oooforum.org/forum/viewtopic.phtml?p=12259

Dim oPropertyValue As Object

Set oPropertyValue = createStruct("com.sun.star.beans.NamedValue")
oPropertyValue.Name = cName
oPropertyValue.Value = uValue

Set OOoNamedValue = oPropertyValue
End Function

Function createStruct(strTypeName As String) As Object
'Fonction de Gibson
'http://www.oooforum.org/forum/viewtopic.phtml?p=12231

Dim objCoreReflection As Object, classSize As Object
Dim aStruct As Object

Set objCoreReflection = _
oServiceManager.createInstance("com.sun.star.reflection.CoreReflection")

Set classSize = objCoreReflection.forName(strTypeName)
classSize.CreateObject aStruct
Set createStruct = aStruct
End Function

VI-B - Lancer un publipostage en appliquant un filtre sur la valeur d'un champ

Description des arguments de la procédure « PublipostageFiltre » :

nomBase : nom de la base intégrée contenant les enregistrements ;

docPrincipal : chemin et Nom du document principal de publipostage(Writer) ;

CmdType : type de données 0=Table 1=Link 2=Query ;

Cmd: nom de la table contenant les enregistrements ;

OutType : détermine la destination du publipostage
1= publipostage vers l'imprimante
2= publipostage vers des fichiers
L'option 2 permet de créer un fichier de fusion pour chaque enregistrement ;

Filtre : utilisez la même syntaxe que pour les clauses WHERE dans les requetes SQL.

Consultez l'aide OpenOffice pour obtenir plus de détails.

L'exemple ci-dessous lance une fusion (en mode impression) uniquement pour les enregistrements, dont le champ nommé « Champ1 » = 'credit' :

Vb

Option Explicit

Dim oServiceManager As Object

Sub Test()
Set oServiceManager = CreateObject("com.sun.star.ServiceManager")

PublipostageFiltre _
"OOoBase", _
"file:///C:/repertoire/monDocument.odt", _
0, _
"maTable", _
1, _
"""Champ1"" = 'credit'"
End Sub

Private Sub PublipostageFiltre(nomBase As String, docPrincipal As String, _
CmdType As Integer, Cmd As String, OutType As Integer, Filtre As String)
Dim Args(5) As Object
Dim objMailMerge As Object

Set objMailMerge = _
oServiceManager.createInstance("com.sun.star.text.MailMerge")

Set Args(0) = OOoNamedValue("DataSourceName", nomBase)
Set Args(1) = OOoNamedValue("DocumentURL", docPrincipal)
Set Args(2) = OOoNamedValue("CommandType", CmdType)
Set Args(3) = OOoNamedValue("Command", Cmd)
Set Args(4) = OOoNamedValue("OutputType", OutType)
Set Args(5) = OOoNamedValue("Filter", Filtre)

objMailMerge.Execute Args()

End Sub

Function OOoNamedValue(cName As String, uValue As Variant) As Object
'Fonction de DannyB
'http://www.oooforum.org/forum/viewtopic.phtml?p=12259

Dim oPropertyValue As Object

Set oPropertyValue = createStruct("com.sun.star.beans.NamedValue")
oPropertyValue.Name = cName
oPropertyValue.Value = uValue

Set OOoNamedValue = oPropertyValue
End Function

Function createStruct(strTypeName As String) As Object
'Fonction de Gibson
'http://www.oooforum.org/forum/viewtopic.phtml?p=12231

Dim objCoreReflection As Object, classSize As Object
Dim aStruct As Object

Set objCoreReflection = _
oServiceManager.createInstance("com.sun.star.reflection.CoreReflection")

Set classSize = objCoreReflection.forName(strTypeName)
classSize.CreateObject aStruct
Set createStruct = aStruct
End Function

VII - Récupérer les macros d'un classeur Excel endommagé

Lorsqu'un classeur Excel est endommagé, une solution de dépannage consiste à l'ouvrir dans OpenOffice. Il est possible d'automatiser le processus de récupération et de remise en forme des macros contenues dans un classeur corrompu.

Récupérer les macros d'un classeur endommagé

VIII - Conclusion

L'utilisation de toutes ces procédures sur différents PC a mis en évidence des fonctionnements disparates d'un poste de travail à l'autre.
Des adaptations seront peut-être nécessaires au cas par cas, en fonction de votre configuration.

Configurations de Test :
WinXP , Excel2002 , OOo2.0.1
WinXP , Excel2000 , OOo2.0.3

IX - Remerciements

Merci à Bbil et Xo pour leur relecture et leurs conseils avisés.