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
Code : Tout sélectionner
oURL.Complete = "macro://OOoClasseurTest/Standard.Module1.Main"
Attention : la procédure est sensible aux majuscules et aux minuscules
bonne soiree
michel