Piloter Open Office depuis Excel

Date de publication : 09.10.2006

Par SilkyRoad (silkyroad.developpez.com)

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

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

I. Préambule
II. Manipuler les fichiers Open Office
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 Open Office 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 Open office sans sauvegarde
II-G. Lister les documents Open Office ouverts
III. Utiliser les filtres de conversion Open Office
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 Open Office (.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 Open Office
V. Déclencher une macro Open Office 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. Téléchargement
X. 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 Open Office:

Consultez le tutoriel de Cyril Beaussier.

Il n'existe pas de bibliothèque pour piloter OOo depuis VB & VBA mais il est possible d'utiliser les API d'Open Office 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":

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

II. Manipuler les fichiers Open Office

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

			
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 Open Office
    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

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 Open Office
    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 Open Office
    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

Open Office 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):

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

    'Création d'une instance Open Office
    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 Open Office protégé par mot de passe

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 Open Office
    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 Open Office 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

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 Open Office
    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 Open Office:
Menu Editer
Option "Entête et pied de page"

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

Sub fermerToutesLesFenetresOOoSansSauvegarde()
    Dim serviceManager As Object, Desktop As Object
    Dim i As Byte
    
    'Création d'une instance Open Office
    Set serviceManager = CreateObject("com.sun.star.serviceManager")
    Set Desktop = serviceManager.createInstance("com.sun.star.frame.Desktop")
    
    'Boucle sur les fenêtres Open Office 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 Open Office ouverts

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 Open Office
    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 Open Office ouverts : " & Nombre & vbLf & vbLf & listeDoc
End Sub


Function typeDoc(Obj As Object) As String
	'
    'adapté d'une procédure Open Office 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 Open Office

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

Voici 3 exemples d'utilisation:

III-A. Lister les filtres de conversion disponibles

Sub ListerNomsFiltresConversion()
    Dim serviceManager As Object, filtresFact As Object
    Dim nomFiltres As Variant
    Dim i As Integer
    
    'Creation instance Open Office
    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 Open Office 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

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 Open Office
    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 Open Office
    Doc.StoreAsURL "file:///C:/monClasseur.ods", Args
    
    '-----------
    'Crée une copie du document Open Office 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 Open Office (module Writer)
     Convertit le document au format PDF
     Referme le document

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 Open Office
    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 Open Office 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 2 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 Open Office (.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 Open Office)

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 Open office
    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

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

Par

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

Remarque 2:

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

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

Remarque 3:

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

Dim Fichier As String
Fichier = "file:///C:/Documents and Settings/michel/dossier/OOoBase.odb"
    
'Indique le nom de la base pour la connection
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

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 Open office
    Set oServiceManager = CreateObject("com.sun.star.ServiceManager")
    Set CreateUnoService = _
    oServiceManager.createInstance("com.sun.star.sdb.DatabaseContext")
    
    'Indique le nom de la base pour la connection
    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'Open Office, il faut parfois remplacer

Set oRequete = oStatement.ExecuteQuery(rSQL)

par

Set oRequete = oStatement.ExecuteUpdate(rSQL)

IV-C. Supprimer un enregistrement dans une table OOo

			
'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

'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 Open Office

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 Open office
    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 2eme 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 Open Office depuis Excel

Cette procédure permet de déclencher la macro d'un document Open Office ouvert et non sauvegardé, nommé "Sans nom1".

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

La macro Open Office est nommée "nomMacroOOo" et située dans le "Module1"

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 Open Office est déjà sauvegardé (OOoTableurTest.ods par exemple), vous pouvez utiliser ce type de syntaxe:

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:

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

VI. Piloter un publipostage Writer depuis VB6/VBA

Ce chapitre propose 2 exemples pour lancer des publipostages Open Office 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 2eme NomFichierFusion_1 ...etc...

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

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

			
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 Open Office 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' .

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 Open Office. 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. Téléchargement

Téléchargez ce tutoriel au format PDF.

X. Remerciements

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

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.