[VBA] Pilotage de OOo depuis MS-Excel

Vos meilleures macros et portions de code sont publiées dans cette section.
Aucun support sur une question de programmation ici !

Modérateur : Vilains modOOs

Règles du forum
Aucune question dans cette section !
Celle-ci rassemble les meilleures macros et portions de code. Vous pouvez en revanche commenter ou argumenter le code exposé. Vous pouvez même remercier l'auteur (cela fait toujours plaisir) en indiquant par exemple dans quel cadre ou contexte vous en avez eu l'utilité.
Si vous avez à poster quelque chose, faites-le depuis la section Macros et API et demandez à un modérateur de l'y déplacer.
MichelXld
Membre OOrganisé
Membre OOrganisé
Messages : 66
Inscription : 10 janv. 2006 22:33

[VBA] Pilotage de OOo depuis MS-Excel

Message par MichelXld »

bonsoir

je ne sais pas si cela peut interesser quelqu'un , mais vous trouverez ci joint quelques exemples pour piloter Open Office depuis Excel
( testé avec Excel2002 & OOo2.0.1 )




Ouvrir un document Texte (odt) existant et insérer des informations à la suite de la derniere ligne

Code : Tout sélectionner

Sub ouvrirOpenOffice()
Dim serviceManager As Object, oText As Object, oCursor As Object
Dim Desktop As Object, Document As Object
Dim Chemin As String, Fichier As String
Dim args()

'adapter le chemin et le nom du fichier en fonction du projet
Chemin = "file:///" & ThisWorkbook.Path
Chemin = Application.WorksheetFunction.Substitute(Chemin, "\", "/")
Fichier = Chemin & "/test.odt"

Set serviceManager = CreateObject("com.sun.star.serviceManager")
Set Desktop = serviceManager.createInstance("com.sun.star.frame.Desktop")
Set Document = Desktop.loadComponentFromURL(Fichier, "_blank", 0, args)
Set oText = Document.getText()
Set oCursor = oText.createTextCursor

oCursor.gotoEnd (False)
oText.insertString oCursor, "Essai d'insertion de texte dans OOo depuis Excel", False
End Sub



Coller une plage de cellules Excel dans un nouveau document texte OOo

Code : Tout sélectionner

Sub creerNouveauDocumentOOo()
Dim oServiceManager As Object, oDispatcher As Object
Dim Desktop As Object, Document As Object
Dim args()
Dim Chemin As String

Range("A1:A5").Copy

Set oServiceManager = CreateObject("com.sun.star.serviceManager")
Set Desktop = oServiceManager.createInstance("com.sun.star.frame.Desktop")
Set Document = Desktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, args)
Set oDispatcher = oServiceManager.createInstance("com.sun.star.frame.DispatchHelper")

oDispatcher.executeDispatch Document.currentController.Frame, ".uno:Paste", "", 0, Array()
End Sub





Compter le nombre de documents Open Office ouverts

Code : Tout sélectionner

Sub compterNombreDocumentsOpenOfficeOuverts()
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
Set oServiceManager = CreateObject("com.sun.star.serviceManager")
Set Desktop = oServiceManager.createInstance("com.sun.star.frame.Desktop")
Set oComponents = Desktop.getComponents()
Set Cible = oComponents.createEnumeration()

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é"
'Else
'leFichier = Right(leFichier, Len(leFichier) - 8)
'leFichier = Application.worksheetFunction.Substitute(leFichier, "\", "/")
'leFichier = Application.worksheetFunction.Substitute(leFichier, "%20", " ")
End If
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 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






Ouvrir un document Open Office qui est protégé par mot de passe

Code : Tout sélectionner

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

Chemin = "file:///" & ThisWorkbook.Path
Chemin = Application.WorksheetFunction.Substitute(Chemin, "\", "/")
Fichier = Chemin & "/test2.odt"

Set serviceManager = CreateObject("com.sun.star.serviceManager")
Set Desktop = serviceManager.createInstance("com.sun.star.frame.Desktop")
Set Args(0) = serviceManager.Bridge_getStruct("com.sun.star.beans.PropertyValue")

Args(0).Name = "Password"
Args(0).Value = "abcd12"
Set Document = Desktop.loadComponentFromURL(Fichier, "_blank", 0, Args())
End Sub





Fermer toutes les fenêtres Open office ouvertes , sans sauvegarde des documents

Code : Tout sélectionner

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

Set serviceManager = CreateObject("com.sun.star.serviceManager")
Set Desktop = serviceManager.createInstance("com.sun.star.frame.Desktop")
For i = 1 To Desktop.Frames.getCount 'compte le nombre de fenetres OOo ouvertes
Desktop.getFrames.getByIndex(0).Close (False)
Next i
End Sub





Afficher les boites de dialogue intégréees Open Office depuis Excel

Code : Tout sélectionner

Sub afficherBoiteDialoguesIntegreesOOo()
'exemple: boite de dialogue "recherche répertoire"
Dim oFolderDialog As Object, serviceManager As Object
Dim i As Integer

Set serviceManager = CreateObject("com.sun.star.serviceManager")
Set oFolderDialog = serviceManager.createInstance("com.sun.star.ui.dialogs.FolderPicker")
oFolderDialog.setDisplayDirectory ("C:\Documents and Settings") 'adapter le chemin par défaut

i = oFolderDialog.Execute()
If i = 1 Then MsgBox oFolderDialog.getDirectory
End Sub





Modifier l'entete et le pied de page d'un document OOo depuis Excel

Code : Tout sélectionner

Sub modificationEnteteClasseur_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

Chemin = "file:///C:\Documents and Settings\michel\dossier\general\excel\OOoClasseur.ods"
Fichier = Application.WorksheetFunction.Substitute(Chemin, "\", "/")

Set serviceManager = CreateObject("com.sun.star.serviceManager")
Set Desktop = serviceManager.createInstance("com.sun.star.frame.Desktop")
Set Document = Desktop.loadComponentFromURL(Fichier, "_blank", 0, args)

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

'infos dans l'entete
Set Entete = leStyle.RightPageHeaderContent
Set oText = Entete.CenterText
oText.setString ("") 'RAZ entete

Set Curseur = oText.CreateTextCursor()
Curseur.CharWeight = 150 'Gras(100 pour normal)
Curseur.CharPosture = 0 '(italique = 2)
Curseur.CharFontName = "Arial"
Curseur.CharHeight = "12" 'taille caracteres
oText.insertString Curseur, "Les données à insérer", False
'-------------------------------------------------------

'pour le Numero page dans le pied de page
Set piedPage = leStyle.RightPageFooterContent
Set oText = piedPage.CenterText
oText.setString ("") 'Reinitialisation de l'entete
Set Curseur = oText.CreateTextCursor()
Set leChamp = Document.createInstance("com.sun.star.text.TextField.PageNumber")
oText.insertTextContent Curseur, leChamp, False
'-------------------------------------------------------

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




Piloter une base ODB depuis Excel
Exemple pour effectuer une requète sur la base de données "Bibliography"

Code : Tout sélectionner

Sub requeteBase_ODB_V02()
'MichelXld le 08.02.2006
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

Set oServiceManager = CreateObject("com.sun.star.ServiceManager")
Set CreateUnoService = oServiceManager.createInstance("com.sun.star.sdb.DatabaseContext")

Set oDB = CreateUnoService.getByName("Bibliography")
Set oBase = oDB.getConnection("", "")
Set oStatement = oBase.createStatement

rSQL = "SELECT Identifier FROM biblio WHERE Author='Böhm, Franz'"
Set oRequete = oStatement.ExecuteQuery(rSQL)

If Not IsNull(oRequete) Then
While oRequete.Next
i = i + 1
Cells(i, 1) = oRequete.getString(1)
Wend
End If

oRequete.Close
oStatement.Close
End Sub




Déclencher une macro Open Office depuis Excel

Cette procédure permet de déclencher la macro d'un document Open Office ouvert, nommé "Sans nom1" .
La macro open Office est nommée "nomMacroOOo" et située dans le "Module1"

Code : Tout sélectionner

Private Sub CommandButton1_Click()
Dim oServiceManager As Object, oURL As Object
Dim oTrans As Object
Dim Desktop As Object, Args(0) 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 Args(0) = oServiceManager.Bridge_getStruct("com.sun.star.beans.PropertyValue")
Set Desktop = oServiceManager.createInstance("com.sun.star.frame.Desktop")
Set oDisp = Desktop.queryDispatch(oURL, "_self", 0)
oDisp.Dispatch oURL, Args()
    
Set oDisp = Nothing
Set Desktop = Nothing
Set oTrans = Nothing
Set oURL = Nothing
Set oServiceManager = Nothing
End Sub
Si le document Open Office est deja sauvegardé sur le disque , vous pouvez utiliser ce type de synthaxe :

Code : Tout sélectionner

oURL.Complete = "macro://OOoClasseurTest/Standard.Module1.Main"
il ne faut pas préciser le type de document ( .ods ,.odt ...)
Attention : la procédure est sensible aux majuscules et aux minuscules




bonne soiree
michel
OOo 2.1 & WinXP(sp2)
Répondre