Connexion Inscription
Accueil › Développement › Sources PureBasic › Utilisation de Work via le com "interop"
Intermédiaire PureBasic 6.x

Utilisation de Work via le com "interop"

module_interop.word.pbi : module PureBasic sans dépendance qui pilote Microsoft Word par COM (x86/x64). Signets, mise en forme, images, tableaux, fusion de documents, export PDF et impression fiable.

module_interop.word.pbi– Piloter Microsoft Word depuis PureBasic :

module_interop.word.pbiest un module PureBasic prêt à inclure qui permet d’automatiser Microsoft Word sans aucune bibliothèque externe. Il suffit d’un XIncludeFile pour ouvrir un modèle, remplir ses signets, mettre le texte en forme, insérer des images ou des tableaux, fusionner plusieurs documents, puis enregistrer le résultat en PDF ou l’envoyer directement à l’imprimante de votre choix.

Né du portage en PureBasic d’un moteur de publipostage écrit à l’origine en C#, module_interop.word.pbi reprend ses fonctions éprouvées dans une forme légère et autonome. Le module gère lui-même le dialogue COM avec Word. Il fonctionne aussi bien en 32 qu’en 64 bits, quelle que soit la version d’Office installée, et remonte les messages d’erreur de Word pour faciliter le diagnostic.

L’impression est fiable : le module attend que Word ait réellement fini d’envoyer le document avant de le fermer, et il rétablit ensuite l’imprimante par défaut de l’utilisateur.

Idéal pour : courriers personnalisés, édition de documents à partir de modèles Word, génération de PDF en série, impression automatisée.

Le code source

module_interop.word.pbiPureBasic · 748 lignes
; =============================================================================
;  module_interop.word.pbi - Pilotage de Word par COM (portage de WordApplication.cs)
;  PureBasic 6.x - Windows - Unicode - x86 ou x64 (Word est hors processus,
;  l'architecture du programme n'a pas besoin de correspondre à celle d'Office)
;  Aucune dépendance : petite couche IDispatch maison.
;  IMPORTANT : appeler toutes les procédures depuis le même thread.
; =============================================================================

DeclareModule WordApp
  ; WdUnderline
  #wdUnderlineNone   = 0
  #wdUnderlineSingle = 1
  #wdUnderlineDouble = 3
  ; WdParagraphAlignment
  #wdAlignParagraphLeft    = 0
  #wdAlignParagraphCenter  = 1
  #wdAlignParagraphRight   = 2
  #wdAlignParagraphJustify = 3
  ; Booléens Word (Font.Bold, Font.Italic...)
  #wdTrue  = -1
  #wdFalse = 0

  Declare.i OpenWord(visible = #True)
  Declare   CloseWord(closeDoc = #True)
  Declare.i OpenDocument(fileName.s)
  Declare   CloseDocument()
  Declare.i SaveDocument(fileName.s)            ; message d'erreur via LastError()
  Declare.s LastError()

  Declare.i PrinterChange(printer.s)
  Declare   RestorePrinter()
  Declare.i PrintDocument(timeoutSecondes = 60)

  Declare.i FusionnerPlusieurFichiers(fichierPrincipal.s, Array fichiersAInserer.s(1))
  Declare   DeletePage(numeroPage)
  Declare   GoToPage(numeroPage)
  Declare.i TextToSignet(nomSignet.s, texte.s)
  Declare.i LocationSignet(nomSignet.s)
  Declare.i SignetCount()                       ; remplace GetAllSignet()
  Declare.s SignetName(index)                   ; index de 1 à SignetCount()
  Declare.i BoldRange(nomSignet.s, value)
  Declare.i ItalicRange(nomSignet.s, value)
  Declare.i UnderLineRange(nomSignet.s, value)
  Declare   AlignmentRange(alignement)
  Declare.i InsertImage(fichierImage.s)
  Declare   ImageSize(pourcent)
  Declare   InsertTable(nombreLignes, nombreColonnes)
EndDeclareModule

Module WordApp
  EnableExplicit

  ; ---------------------------------------------------------------------------
  ;  Couche COM / IDispatch
  ; ---------------------------------------------------------------------------
  #DSP_METHOD  = 1
  #DSP_PROPGET = 2
  #DSP_PROPPUT = 4
  #DSP_LCID    = $0400        ; LOCALE_USER_DEFAULT
  #DSP_CLSCTX  = 4            ; CLSCTX_LOCAL_SERVER

  #DV_EMPTY    = 0
  #DV_I2       = 2
  #DV_I4       = 3
  #DV_R4       = 4
  #DV_R8       = 5
  #DV_BSTR     = 8
  #DV_DISPATCH = 9
  #DV_ERROR    = 10
  #DV_BOOL     = 11

  Structure DVARIANT Align #PB_Structure_AlignC
    vt.w
    wReserved1.w
    wReserved2.w
    wReserved3.w
    StructureUnion
      lVal.l
      iVal.w
      boolVal.w
      scode.l
      fltVal.f
      dblVal.d
      bstrVal.i
      pdispVal.i
      brecord.i[2]
    EndStructureUnion
  EndStructure

  Structure DPARAMS Align #PB_Structure_AlignC
    *rgvarg
    *rgdispidNamedArgs
    cArgs.l
    cNamedArgs.l
  EndStructure

  Structure DEXCEPINFO Align #PB_Structure_AlignC
    wCode.w
    wReserved.w
    bstrSource.i
    bstrDescription.i
    bstrHelpFile.i
    dwHelpContext.l
    pvReserved.i
    pfnDeferredFillIn.i
    scode.l
  EndStructure

  Global *appWord.IDispatch
  Global *myDocument.IDispatch
  Global *myRange.IDispatch
  Global *mySignet.IDispatch
  Global *myImage.IDispatch
  Global previousPrinter.s, hasPrevious
  Global gLastError.s
  Global comInit
  Global Dim gArgs.DVARIANT(15)
  Global gArgCount

  Macro RelVar(v)
    Rel(v)
    v = 0
  EndMacro

  Procedure Rel(*obj.IDispatch)
    If *obj
      *obj\Release()
    EndIf
  EndProcedure

  ; ---- Arguments (dans l'ordre naturel, l'inversion est faite à l'appel) ----

  Procedure ArgsReset()
    Protected i
    For i = 0 To gArgCount - 1
      VariantClear_(@gArgs(i))
    Next
    gArgCount = 0
  EndProcedure

  Procedure.i ArgNext()
    Protected *v.DVARIANT = @gArgs(gArgCount)
    FillMemory(*v, SizeOf(DVARIANT), 0)
    gArgCount + 1
    ProcedureReturn *v
  EndProcedure

  Procedure ArgStr(s.s)
    Protected *v.DVARIANT = ArgNext()
    *v\vt = #DV_BSTR
    *v\bstrVal = SysAllocString_(s)
  EndProcedure

  Procedure ArgLong(n.l)
    Protected *v.DVARIANT = ArgNext()
    *v\vt = #DV_I4
    *v\lVal = n
  EndProcedure

  Procedure ArgFloat(f.f)
    Protected *v.DVARIANT = ArgNext()
    *v\vt = #DV_R4
    *v\fltVal = f
  EndProcedure

  Procedure ArgBool(b)
    Protected *v.DVARIANT = ArgNext()
    *v\vt = #DV_BOOL
    If b
      *v\boolVal = -1
    Else
      *v\boolVal = 0
    EndIf
  EndProcedure

  Procedure ArgMissing()            ; équivalent de System.Reflection.Missing.Value
    Protected *v.DVARIANT = ArgNext()
    *v\vt = #DV_ERROR
    *v\scode = $80020004            ; DISP_E_PARAMNOTFOUND
  EndProcedure

  Procedure ArgObj(*obj.IDispatch)
    Protected *v.DVARIANT = ArgNext()
    *v\vt = #DV_DISPATCH
    *v\pdispVal = *obj
    If *obj
      *obj\AddRef()                 ; libéré par VariantClear_ dans ArgsReset()
    EndIf
  EndProcedure

  ; ---- Appel générique ----

  Procedure.l DispInvoke(*obj.IDispatch, name.s, flags, *result.DVARIANT = 0)
    Protected hr.l, dispid.l, *pName = @name
    Protected params.DPARAMS, ex.DEXCEPINFO, putId.l = -3   ; DISPID_PROPERTYPUT
    Protected *rev, i

    If *result
      FillMemory(*result, SizeOf(DVARIANT), 0)
    EndIf

    If *obj = 0
      gLastError = "Objet COM nul (" + name + ")"
      ArgsReset()
      ProcedureReturn -1
    EndIf

    hr = *obj\GetIDsOfNames(?IID_NULL, @*pName, 1, #DSP_LCID, @dispid)
    If hr < 0
      gLastError = "Membre COM inconnu : " + name
      ArgsReset()
      ProcedureReturn hr
    EndIf

    If gArgCount > 0
      *rev = AllocateMemory(SizeOf(DVARIANT) * gArgCount)
      For i = 0 To gArgCount - 1
        CopyMemory(@gArgs(i), *rev + (gArgCount - 1 - i) * SizeOf(DVARIANT), SizeOf(DVARIANT))
      Next
      params\rgvarg = *rev
      params\cArgs  = gArgCount
    EndIf
    If flags & #DSP_PROPPUT
      params\rgdispidNamedArgs = @putId
      params\cNamedArgs = 1
    EndIf

    hr = *obj\Invoke(dispid, ?IID_NULL, #DSP_LCID, flags, @params, *result, @ex, 0)

    If hr < 0
      If (hr & $FFFFFFFF) = $80020009 And ex\bstrDescription   ; DISP_E_EXCEPTION
        gLastError = PeekS(ex\bstrDescription)
      Else
        gLastError = name + " : erreur COM $" + Hex(hr & $FFFFFFFF)
      EndIf
      Debug "WordApp : " + gLastError
    EndIf
    If ex\bstrSource      : SysFreeString_(ex\bstrSource)      : EndIf
    If ex\bstrDescription : SysFreeString_(ex\bstrDescription) : EndIf
    If ex\bstrHelpFile    : SysFreeString_(ex\bstrHelpFile)    : EndIf

    If *rev
      FreeMemory(*rev)
    EndIf
    ArgsReset()
    ProcedureReturn hr
  EndProcedure

  ; ---- Raccourcis ----

  Procedure.i GetObj(*obj, name.s, flags = #DSP_PROPGET)   ; l'appelant doit faire Rel()
    Protected r.DVARIANT
    If DispInvoke(*obj, name, flags, @r) >= 0 And r\vt = #DV_DISPATCH
      ProcedureReturn r\pdispVal
    EndIf
    VariantClear_(@r)
    ProcedureReturn 0
  EndProcedure

  Procedure.i CallObj(*obj, name.s)
    ProcedureReturn GetObj(*obj, name, #DSP_METHOD | #DSP_PROPGET)
  EndProcedure

  Procedure.i CallVoid(*obj, name.s)
    Protected r.DVARIANT, hr.l
    hr = DispInvoke(*obj, name, #DSP_METHOD, @r)
    VariantClear_(@r)
    ProcedureReturn Bool(hr >= 0)
  EndProcedure

  Procedure.i GetLong(*obj, name.s, flags = #DSP_PROPGET, defaut = 0)
    Protected r.DVARIANT, v = defaut
    If DispInvoke(*obj, name, flags, @r) >= 0
      Select r\vt
        Case #DV_I2   : v = r\iVal
        Case #DV_I4   : v = r\lVal
        Case #DV_BOOL : v = Bool(r\boolVal <> 0)
        Case #DV_R4   : v = Int(r\fltVal)
        Case #DV_R8   : v = Int(r\dblVal)
      EndSelect
    EndIf
    VariantClear_(@r)
    ProcedureReturn v
  EndProcedure

  Procedure.f GetFloat(*obj, name.s)
    Protected r.DVARIANT, v.f
    If DispInvoke(*obj, name, #DSP_PROPGET, @r) >= 0
      Select r\vt
        Case #DV_R4 : v = r\fltVal
        Case #DV_R8 : v = r\dblVal
        Case #DV_I4 : v = r\lVal
        Case #DV_I2 : v = r\iVal
      EndSelect
    EndIf
    VariantClear_(@r)
    ProcedureReturn v
  EndProcedure

  Procedure.s GetStr(*obj, name.s, flags = #DSP_PROPGET)
    Protected r.DVARIANT, s.s
    If DispInvoke(*obj, name, flags, @r) >= 0 And r\vt = #DV_BSTR And r\bstrVal
      s = PeekS(r\bstrVal)
    EndIf
    VariantClear_(@r)
    ProcedureReturn s
  EndProcedure

  Procedure.i PutLong(*obj, name.s, n.l)
    ArgLong(n)
    ProcedureReturn Bool(DispInvoke(*obj, name, #DSP_PROPPUT) >= 0)
  EndProcedure

  Procedure.i PutFloat(*obj, name.s, f.f)
    ArgFloat(f)
    ProcedureReturn Bool(DispInvoke(*obj, name, #DSP_PROPPUT) >= 0)
  EndProcedure

  Procedure.i PutBool(*obj, name.s, b)
    ArgBool(b)
    ProcedureReturn Bool(DispInvoke(*obj, name, #DSP_PROPPUT) >= 0)
  EndProcedure

  Procedure.i PutStr(*obj, name.s, s.s)
    ArgStr(s)
    ProcedureReturn Bool(DispInvoke(*obj, name, #DSP_PROPPUT) >= 0)
  EndProcedure

  ; ---------------------------------------------------------------------------
  ;  Utilitaires internes
  ; ---------------------------------------------------------------------------

  Procedure ReleaseDocumentObjects()
    RelVar(*myImage)
    RelVar(*mySignet)
    RelVar(*myRange)
    RelVar(*myDocument)
  EndProcedure

  Procedure.i CreerDossier(dir.s)     ; création récursive (comme Directory.CreateDirectory)
    dir = RTrim(dir, "\")
    If dir = "" Or FileSize(dir) = -2
      ProcedureReturn #True
    EndIf
    If Len(dir) <= 2 And Right(dir, 1) = ":"
      ProcedureReturn #True
    EndIf
    If Not CreerDossier(GetPathPart(dir))
      ProcedureReturn #False
    EndIf
    CreateDirectory(dir)
    ProcedureReturn Bool(FileSize(dir) = -2)
  EndProcedure

  ; CORRECTION IMPRESSION : attend que Word ait vidé sa file d'impression
  Procedure.i WaitForPrinting(timeoutSecondes = 60)
    Protected i, maxBoucles = timeoutSecondes * 10
    If *appWord = 0
      ProcedureReturn #True
    EndIf
    For i = 1 To maxBoucles
      Select GetLong(*appWord, "BackgroundPrintingStatus", #DSP_PROPGET, -1)
        Case 0  : ProcedureReturn #True
        Case -1 : Break                     ; erreur COM
      EndSelect
      Delay(100)
    Next
    Debug "Délai d'attente d'impression dépassé."
    ProcedureReturn #False
  EndProcedure

  ; ---------------------------------------------------------------------------
  ;  Application / document
  ; ---------------------------------------------------------------------------

  Procedure.s LastError()
    ProcedureReturn gLastError
  EndProcedure

  Procedure.i OpenWord(visible = #True)
    Protected clsid.GUID, hr.l, *opt
    gLastError = ""
    If *appWord
      ProcedureReturn #True
    EndIf
    If Not comInit
      CoInitialize_(0)
      comInit = #True
    EndIf

    hr = CLSIDFromProgID_("Word.Application", @clsid)
    If hr < 0
      gLastError = "Word n'est pas installé (Word.Application introuvable)."
      ProcedureReturn #False
    EndIf
    hr = CoCreateInstance_(@clsid, 0, #DSP_CLSCTX, ?IID_IDispatch, @*appWord)
    If hr < 0 Or *appWord = 0
      gLastError = "Impossible de lancer Word : $" + Hex(hr & $FFFFFFFF)
      *appWord = 0
      ProcedureReturn #False
    EndIf

    PutBool(*appWord, "Visible", visible)
    If Not visible
      PutLong(*appWord, "DisplayAlerts", 0)      ; wdAlertsNone
    EndIf

    ; CORRECTION IMPRESSION : impression au premier plan
    *opt = GetObj(*appWord, "Options")
    PutBool(*opt, "PrintBackground", #False)
    Rel(*opt)

    *myDocument = 0
    ProcedureReturn #True
  EndProcedure

  Procedure CloseDocument()
    If *myDocument = 0
      ProcedureReturn
    EndIf
    WaitForPrinting()                            ; CORRECTION IMPRESSION
    ArgBool(#False)                              ; SaveChanges = False
    CallVoid(*myDocument, "Close")
    ReleaseDocumentObjects()
  EndProcedure

  Procedure CloseWord(closeDoc = #True)
    If closeDoc
      CloseDocument()
    EndIf
    If *appWord
      WaitForPrinting()                          ; CORRECTION IMPRESSION
      RestorePrinter()
      ReleaseDocumentObjects()
      ArgBool(#False)                            ; SaveChanges = False
      CallVoid(*appWord, "Quit")
      RelVar(*appWord)
    EndIf
    If comInit
      CoUninitialize_()
      comInit = #False
    EndIf
  EndProcedure

  Procedure.i OpenDocument(fileName.s)
    Protected *docs, i
    If *appWord = 0 Or FileSize(fileName) < 0
      ProcedureReturn #False
    EndIf
    ReleaseDocumentObjects()

    *docs = GetObj(*appWord, "Documents")
    ArgStr(fileName)      ; FileName
    ArgMissing()          ; ConfirmConversions
    ArgBool(#False)       ; ReadOnly
    ArgBool(#False)       ; AddToRecentFiles
    For i = 1 To 7        ; PasswordDocument ... Encoding
      ArgMissing()
    Next
    ArgBool(#True)        ; Visible
    *myDocument = CallObj(*docs, "Open")
    Rel(*docs)
    ProcedureReturn Bool(*myDocument <> 0)
  EndProcedure

  Procedure.i SaveDocument(fileName.s)
    Protected dir.s
    gLastError = ""
    If fileName = ""
      gLastError = "Nom de fichier vide."
      ProcedureReturn #False
    EndIf
    If *myDocument = 0
      gLastError = "Aucun document ouvert."
      ProcedureReturn #False
    EndIf

    dir = GetPathPart(fileName)
    If dir <> "" And Not CreerDossier(dir)
      gLastError = "Impossible de créer le dossier : " + dir
      ProcedureReturn #False
    EndIf

    ArgStr(fileName)
    ArgLong(17)                                  ; wdFormatPDF
    ProcedureReturn Bool(DispInvoke(*myDocument, "SaveAs", #DSP_METHOD) >= 0)
  EndProcedure

  ; ---------------------------------------------------------------------------
  ;  Impression
  ; ---------------------------------------------------------------------------

  Procedure.i PrinterChange(printer.s)
    Protected actuelle.s, *opt
    If *appWord = 0 Or printer = ""
      ProcedureReturn #False
    EndIf

    If Not hasPrevious
      previousPrinter = GetStr(*appWord, "ActivePrinter")
      hasPrevious = #True
    EndIf

    If Not PutStr(*appWord, "ActivePrinter", printer)
      Debug "Erreur changement imprimante (" + printer + ") : " + gLastError
      ProcedureReturn #False
    EndIf
    *opt = GetObj(*appWord, "Options")
    PutBool(*opt, "PrintBackground", #False)
    Rel(*opt)

    Delay(1000)

    ; Word renvoie "Nom sur Ne01:" : on vérifie juste le début
    actuelle = GetStr(*appWord, "ActivePrinter")
    If LCase(Left(actuelle, Len(printer))) <> LCase(printer)
      Debug "Imprimante non changée. Demandée : " + printer + " / Active : " + actuelle
      ProcedureReturn #False
    EndIf
    ProcedureReturn #True
  EndProcedure

  Procedure RestorePrinter()
    If Not hasPrevious Or *appWord = 0
      ProcedureReturn
    EndIf
    PutStr(*appWord, "ActivePrinter", previousPrinter)
    previousPrinter = ""
    hasPrevious = #False
  EndProcedure

  Procedure.i PrintDocument(timeoutSecondes = 60)
    If *myDocument = 0
      ProcedureReturn #False
    EndIf
    ArgBool(#False)                              ; Background = False (1er paramètre de PrintOut)
    If DispInvoke(*myDocument, "PrintOut", #DSP_METHOD) < 0
      Debug "Erreur impression : " + gLastError
      ProcedureReturn #False
    EndIf
    ProcedureReturn WaitForPrinting(timeoutSecondes)
  EndProcedure

  ; ---------------------------------------------------------------------------
  ;  Signets, pages, mise en forme
  ; ---------------------------------------------------------------------------

  Procedure.i LocationSignet(nomSignet.s)
    Protected *bms, *bm, *r, ok = #False
    If *myDocument = 0
      ProcedureReturn #False
    EndIf
    *bms = GetObj(*myDocument, "Bookmarks")
    ArgStr(nomSignet)
    If GetLong(*bms, "Exists", #DSP_METHOD)
      ArgStr(nomSignet)
      *bm = CallObj(*bms, "Item")
      If *bm
        RelVar(*mySignet)
        *mySignet = *bm
        CallVoid(*mySignet, "Select")
        *r = GetObj(*mySignet, "Range")
        RelVar(*myRange)
        *myRange = *r
        ok = Bool(*r <> 0)
      EndIf
    EndIf
    Rel(*bms)
    ProcedureReturn ok
  EndProcedure

  Procedure.i SignetCount()
    Protected *bms, n
    If *myDocument = 0
      ProcedureReturn 0
    EndIf
    *bms = GetObj(*myDocument, "Bookmarks")
    n = GetLong(*bms, "Count")
    Rel(*bms)
    ProcedureReturn n
  EndProcedure

  Procedure.s SignetName(index)
    Protected *bms, *bm, s.s
    If *myDocument = 0
      ProcedureReturn ""
    EndIf
    *bms = GetObj(*myDocument, "Bookmarks")
    ArgLong(index)
    *bm = CallObj(*bms, "Item")
    s = GetStr(*bm, "Name")
    Rel(*bm)
    Rel(*bms)
    ProcedureReturn s
  EndProcedure

  Procedure GoToPage(numeroPage)
    Protected *r
    If *myDocument = 0
      ProcedureReturn
    EndIf
    ArgLong(1)                                   ; What  = wdGoToPage
    ArgLong(1)                                   ; Which = wdGoToFirst
    ArgLong(numeroPage)                          ; Count
    *r = CallObj(*myDocument, "GoTo")
    If *r
      RelVar(*myRange)
      *myRange = *r
      CallVoid(*myRange, "Select")
    EndIf
  EndProcedure

  Procedure DeletePage(numeroPage)
    Protected *sel
    GoToPage(numeroPage)
    *sel = GetObj(*appWord, "Selection")
    CallVoid(*sel, "TypeBackspace")
    Rel(*sel)
  EndProcedure

  ; Le tableau est pris en entier (indices 0 à ArraySize), comme FichiersAInserer en C#
  Procedure.i FusionnerPlusieurFichiers(fichierPrincipal.s, Array fichiersAInserer.s(1))
    Protected n = ArraySize(fichiersAInserer()) + 1, i
    If Not OpenDocument(fichierPrincipal)
      ProcedureReturn #False
    EndIf
    If Not LocationSignet("FinPage")
      ProcedureReturn #False
    EndIf

    ArgLong(7)                                   ; wdPageBreak
    CallVoid(*myRange, "InsertBreak")
    For i = n - 1 To 0 Step -1
      If FileSize(fichiersAInserer(i)) >= 0
        ArgStr(fichiersAInserer(i))
        CallVoid(*myRange, "InsertFile")
      EndIf
    Next
    DeletePage(n + 2)
    ProcedureReturn #True
  EndProcedure

  Procedure.i TextToSignet(nomSignet.s, texte.s)
    If LocationSignet(nomSignet)
      ArgStr(texte)
      CallVoid(*myRange, "InsertAfter")
      ProcedureReturn #True
    EndIf
    ProcedureReturn #False
  EndProcedure

  Procedure.i SetFont(nomSignet.s, prop.s, value)
    Protected *font
    If Not LocationSignet(nomSignet)
      ProcedureReturn #False
    EndIf
    *font = GetObj(*myRange, "Font")
    PutLong(*font, prop, value)
    Rel(*font)
    ProcedureReturn #True
  EndProcedure

  Procedure.i BoldRange(nomSignet.s, value)
    ProcedureReturn SetFont(nomSignet, "Bold", value)
  EndProcedure

  Procedure.i ItalicRange(nomSignet.s, value)
    ProcedureReturn SetFont(nomSignet, "Italic", value)
  EndProcedure

  Procedure.i UnderLineRange(nomSignet.s, value)
    ProcedureReturn SetFont(nomSignet, "Underline", value)
  EndProcedure

  Procedure AlignmentRange(alignement)
    Protected *pf
    If *myRange = 0
      ProcedureReturn
    EndIf
    *pf = GetObj(*myRange, "ParagraphFormat")
    PutLong(*pf, "Alignment", alignement)
    Rel(*pf)
  EndProcedure

  Procedure.i InsertImage(fichierImage.s)
    Protected *shapes, *img
    If *myRange = 0 Or FileSize(fichierImage) < 0
      ProcedureReturn #False
    EndIf
    *shapes = GetObj(*myRange, "InlineShapes")
    ArgStr(fichierImage)                         ; FileName
    ArgBool(#False)                              ; LinkToFile
    ArgBool(#True)                               ; SaveWithDocument
    *img = CallObj(*shapes, "AddPicture")
    Rel(*shapes)
    If *img = 0
      ProcedureReturn #False
    EndIf
    RelVar(*myImage)
    *myImage = *img
    ProcedureReturn #True
  EndProcedure

  Procedure ImageSize(pourcent)
    Protected h.f, w.f
    If *myImage = 0
      ProcedureReturn
    EndIf
    h = GetFloat(*myImage, "Height")
    w = GetFloat(*myImage, "Width")
    PutFloat(*myImage, "Height", h * pourcent / 100.0)
    PutFloat(*myImage, "Width",  w * pourcent / 100.0)
  EndProcedure

  Procedure InsertTable(nombreLignes, nombreColonnes)
    Protected *tables, *t, *r
    If *myDocument = 0 Or *myRange = 0
      ProcedureReturn
    EndIf
    *tables = GetObj(*myDocument, "Tables")
    ArgObj(*myRange)                             ; Range
    ArgLong(nombreLignes)
    ArgLong(nombreColonnes)
    ArgLong(1)                                   ; wdWord9TableBehavior
    ArgLong(0)                                   ; wdAutoFitFixed
    *t = CallObj(*tables, "Add")
    If *t
      *r = GetObj(*t, "Range")
      If *r
        RelVar(*myRange)
        *myRange = *r
      EndIf
      Rel(*t)
    EndIf
    Rel(*tables)
  EndProcedure

  DataSection
    IID_NULL:
    Data.l 0
    Data.w 0, 0
    Data.b 0, 0, 0, 0, 0, 0, 0, 0
    IID_IDispatch:                               ; {00020400-0000-0000-C000-000000000046}
    Data.l $00020400
    Data.w 0, 0
    Data.b $C0, 0, 0, 0, 0, 0, 0, $46
  EndDataSection
EndModule
‹ Retour à Sources PureBasic