Re: [prog] RE : [prog] VB et commandes UNO

[Didier Dorange-Pattoret]

Mon module complet:     Dim oServiceManager, oDispatcher, oBasicLibraries, oDialogLibraries, oXrayTool, oXrayModule As Object     Dim oDesktop As Object, oDocument As Object, oSel As Object     Dim Arguments(0) As Object     Sub openDoc(ByVal FichierATraiter As String, Optional ByVal clInvisible As Boolean = False)         Dim FichierFormaté As String         LoadService()         Arguments(0) = MakePropertyValue("Hidden", clInvisible)         FichierFormaté = ConvertToUrl(FichierATraiter)         oDocument = oDesktop.loadComponentFromURL(FichierFormaté, "_blank", 0, Arguments)         VBXray(oDocument)         CloseDoc(oDocument)     End Sub     Sub VBXray(ByRef oObj As Object)         Dim Arguinvoke1(0), Arguinvoke2(0), Arguinvoke3(0) As Object         Arguinvoke1(0) = oObj         lancerMacroBasic("XrayTool._Main.Xray", Arguinvoke1, Arguinvoke2, Arguinvoke3)     End Sub     Public Function ConvertToUrl(ByVal strFile As String) As String         strFile = Replace(strFile, "\", "/")         strFile = Replace(strFile, ":", "|")         strFile = Replace(strFile, " ", "%20")         strFile = "file:///" + strFile         ConvertToUrl = strFile     End Function     Public Function MakePropertyValue(ByVal cName As String, ByVal uValue As VariantType) As Object         Dim oStruct As Object         oStruct = oServiceManager.Bridge_GetStruct("com.sun.star.beans.PropertyValue")         oStruct.Name = cName         oStruct.Value = uValue         MakePropertyValue = oStruct     End Function     Public Function LoadService() As Boolean         On Error GoTo Sortie         oServiceManager = CreateObject("com.sun.star.ServiceManager")         oDesktop = oServiceManager.createInstance("com.sun.star.frame.Desktop")         oDispatcher = oServiceManager.createInstance("com.sun.star.frame.DispatchHelper")         oBasicLibraries = CreateUnoService("com.sun.star.script.ApplicationScriptLibraryContainer")         oDialogLibraries = CreateUnoService("com.sun.star.script.ApplicationDialogLibraryContainer")         If oBasicLibraries.hasByname("XrayTool") Then             oXrayTool = oBasicLibraries.getbyname("XrayTool")             oXrayModule = oXrayTool.getbyname("_Main")         End If         oBasicLibraries.loadlibrary("XrayTool")         LoadService = True Sortie:         LoadService = False     End Function     Public Sub Copy(ByVal oDoc As Object)         oSel = oDoc.CurrentController.Frame         oDispatcher.executeDispatch(oSel, ".uno:Copy", "", 0, Arguments)     End Sub     Public Sub SelectAll(ByVal oDoc As Object)         oSel = oDoc.CurrentController.Frame         oDispatcher.executeDispatch(oSel, ".uno:SelectAll", "", 0, Arguments)     End Sub     Public Sub Escape(ByVal oDoc As Object)         oSel = oDoc.CurrentController.Frame         oDispatcher.executeDispatch(oSel, ".uno:Escape", "", 0, Arguments)     End Sub     Public Sub Paste(ByVal oDoc As Object)         oSel = oDoc.CurrentController.Frame         oDispatcher.executeDispatch(oSel, ".uno:Paste", "", 0, Arguments)     End Sub     Public Sub CloseDoc(ByVal oDoc As Object)         On Error Resume Next         oDoc.Close(True)     End Sub     Public Function ControleDroits(ByVal LeChemin As String) As Boolean         On Error GoTo PasDroit         LeChemin = LeChemin + "\temp.txt"         Dim file As System.IO.FileStream         file = System.IO.File.Create(LeChemin)         file.Close()         Kill(LeChemin)         ControleDroits = True         Exit Function PasDroit:         ControleDroits = False     End Function     Public Function ConvertFromUrl(ByVal strFile As String) As String         strFile = Replace(strFile, "file:///", "")         strFile = Replace(strFile, "/", "\")         strFile = Replace(strFile, "|", ":")         strFile = Replace(strFile, "%20", " ")         ConvertFromUrl = strFile     End Function     Public Function GetRepertoirePath(ByVal sInstPath As String) As String         'donne le répertoire correspondant à utiliser avec prog,home,inst,work,lang,vlang,temp ...         Dim oPathSubstSrv As Object         Dim sPath As String         sInstPath = "$(" + sInstPath + ")"         oPathSubstSrv = CreateUnoService("com.sun.star.comp.framework.PathSubstitution")         sPath = oPathSubstSrv.getSubstituteVariableValue(sInstPath)         GetRepertoirePath = sPath     End Function     Public Function CreateUnoService(ByVal strServiceName As String) As Object         Dim oServiceManager As Object         oServiceManager = CreateObject("com.sun.star.ServiceManager")         CreateUnoService = oServiceManager.createInstance(strServiceName)     End Function     Public Sub CloseOOo()         Dim I As Integer         Dim prc As System.Diagnostics.Process() = Process.GetProcessesByName("soffice.bin")         Call FermeToutesLesFenetres()         For I = LBound(prc) To UBound(prc)             prc(I).CloseMainWindow()             prc(I).Kill()             prc(I).Close()         Next         prc = Nothing     End Sub     Public Sub FermeToutesLesFenetres()         Dim myEnum, oDoc As Object         'On Error Resume Next         myEnum = oDesktop.Components.CreateEnumeration         Do While myEnum.HasmoreElements             oDoc = myEnum.NextElement             If HasUnoInterface(oDoc, "com.sun.star.util.XCloseable") Then                 oDoc.close(True)             Else                 oDoc.dispose()             End If         Loop         On Error GoTo 0     End Sub     Public Function HasUnoInterface(ByVal oObj As Object, ByVal cInterfaceName As String) As Boolean         HasUnoInterface = False         Dim oIntrospection, oObjInfo, oMethod As Object         Dim oMethods As Array         Dim cMethodInterfaceName As String         Dim i As Integer         ' Get the Introspection service.         oIntrospection = CreateUnoService("com.sun.star.beans.Introspection")         ' Now inspect the object to learn about it.           oObjInfo = oIntrospection.inspect(oObj)         ' Obtain an array describing all methods of the object.         oMethods = oObjInfo.getMethods(-1) 'com.sun.star.beans.MethodConcept.ALL)         ' Now look at every method.         For i = LBound(oMethods) To UBound(oMethods)             oMethod = oMethods(i)             ' Check the method's interface to see if             '  these aren't the droids you're looking for.             cMethodInterfaceName = oMethod.getDeclaringClass().getName()             If cMethodInterfaceName = cInterfaceName Then                 HasUnoInterface = True                 Exit Function             End If         Next     End Function     Sub lancerMacroBasic(ByVal nomScript As String, ByVal Arguinvoke1 As Object, ByVal Arguinvoke2 As Object, ByVal Arguinvoke3 As Object)         Dim mspf As Object, scriptPro As Object, monScript As Object         mspf = CreateUnoService("com.sun.star.script.provider.MasterScriptProviderFactory")         scriptPro = mspf.createScriptProvider("")         On Error GoTo PasScript1         monScript = scriptPro.getScript("vnd.sun.star.script:" & nomScript & "?language=Basic&location=application")         ' appel de script simple, sans arguments et sans résultat en retour         monScript.invoke(Arguinvoke1, Arguinvoke2, Arguinvoke3)         On Error GoTo 0         Exit Sub PasScript1:         Resume PasScript2 PasScript2:         MsgBox("Script pas trouvé : " & nomScript, 16)     End Sub