unit UtilWord; //----------------------------------------------------------------- // Unit WORD : // // Declaration minimale a faire dans le programme d'utilisation // uses UnitWord; // // // Exemple d'Utilisation // var // ListSrc : TStrings; // Liste des mots clé a rechercher // ListDest : TStrings; // Liste des mots de remplacement // FicWord : TDDUtilWord; // // begin // FicWord := TDDUtilWord.Create; // FicUtilWord.OnReplace := IncJauge; // si on souhaite gérer un evenement à chaque remplacement // ListSrc := TStringlist.Create; // ListDest := TStringlist.Create; // ListSrc.Add('#AncienMot#'); // ListDest.add('#NouveauMot#'); // FicWord.AffMessage := True; // Afficher les mesages d'alerte; // FicWord.WordVisible := False; // Ne pas afficher Word // FicWord.FileDir := 'c:\'; // Dossier des fichiers // FicWord.OpenFile('essai.doc'); // Ouvrir le document // FicWord.replace(listdeb,listfin) // Effectuer les remplacments // FicWord.InsertTabPicture('c:\img.jpg, '#IMG#') // Insérer une image dans un tableau // FicWord.PrintFile(True); // Imprimer le fichier avec un appercu ecran // FicWord.CloseFile(False,False); // Fermer Word sans sauvegarder // end; // // Exemple de toutes les fonctions // if not OpenModel('Constat.dot') then Showmessage('modele introuvable'); // if not OpenFile('essai.doc') then Showmessage('fichier introuvable'); // if not CloseFile(CBSave.Checked, CBQuit.Checked) then Showmessage('Fermeture impossible'); // if not Replace(LBRech.Items,LBRemp.Items) then ShowMessage('Remplacement non terminé'); // if not NewPicture('C:\essai.jpg', 100, 100, 100, 100) then showmessage('Erreur de création de l''image'); // if not InsertEntetePied('@LogiConstat', True) then showmessage('Erreur d''insertion d''entete'); // if not InsertPicture('C:\essai.jpg', 1) then showmessage('Erreur d''insertion de l''image'); // if not SaveFile('',CBSaveAs.Checked) then showmessage('Sauveagrde non effectuée'); // PrintFile(CBPreview.Checked); // CloseAllWord(CBSave.Checked); // if not CloseAllWord(CBSave.Checked) then Showmessage('Fermeture impossible'); // // Gestion de l'evenemt OnReplace : déclarer une procedure // Private // procedure IncJauge(Sender: TObject; Progression, Total: Integer); // // procedure TFrmWord.IncJauge(Sender: TObject; Progression, Total: Integer); // //Procedure de gestion de la barre de progression // begin // PBJauge.Max := Total; // PBJauge.Position := Progression; // end; // // // interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, StdCtrls, Buttons, StrUtils, OleCtnrs, ComObj, tlHelp32, WordXP, Dialogs; type TProgress = procedure(Sender: TObject; Progression, Total: Integer) of object; TDDUtilWord = class(TObject) private SaveDialog1 : TSaveDialog; NumInstance : Integer; WordAppli : array[1..100] of variant; // Application Word DocWord : array[1..100] of variant; // Liste des documents fCountImg : Integer; fModelDir : String; fFileDir : String; fPictDir : String; fFileName : String; fWordVisible : Boolean; fAffMessage : Boolean; fModeDev : Boolean; FOnRempProgress : TProgress; function GetExistsZone(Zone : Integer) : Boolean; procedure SetModelDir(const Value: String); procedure SetFileDir(const Value: String); procedure SetPictDir(const Value: String); procedure SetWordVisible(const Value : Boolean); procedure SetConnect; function CloseSession : Boolean; public // Constructor Create(FilePath : String;PassWord : String); Constructor Create; Destructor Destroy;Override; property ModeDev : Boolean read fModeDev write fModeDev default False; // * Pour eviter les messages d'erreur a l'execution property ModelDir : string read fModelDir write SetModelDir; // * Emplacement des modeles property FileDir : string read fFileDir write SetFileDir; // * Emplacement des fichiers property PictDir : string read fPictDir write SetPictDir; // * Emplacement des images property WordVisible : Boolean read fWordVisible write SetWordVisible default false; // indique si lon souhaite voir Word property AffMessage : Boolean read fAffMessage write fAffMessage default true; // indique si lon souhaite afficher les message d'alerte property OnReplace : TProgress read FOnRempProgress write FOnRempProgress; function OpenFile(FileName : String): Boolean; function OpenModel(ModelName : String): Boolean; function CloseFile(FlagSave, FlagCloseWord : Boolean): Boolean; function NewPicture(PictureName : String; Left, Top, Width, Height : Integer) : Boolean; function InsertPicture(PictureName : String; NumZone : Integer) : Boolean; function InsertTabPicture(PictureName, CodeChaine: String): Boolean; function InsereTab(CodeEmpl : String; NbRow, NbCol, RHeight, CWidth : Integer; ListRemp : TStrings; FCadre: Boolean): Boolean; function Replace(ListRech, ListRemp : TStrings) : Boolean; function InsertEntetePied(Texte : String; Head : Boolean) : Boolean; function SaveFile(FileName : String; FlagBox : Boolean) : Boolean; function PrintFile(FlagPrev : Boolean) : Boolean; function CloseAllWord(FlagSave : Boolean) : boolean; end; implementation //Constructor TDDUtilWord.Create(FilePath : String;PassWord : String); Constructor TDDUtilWord.Create; begin Inherited Create; // Héritage de TObject end; Destructor TDDUtilWord.Destroy; begin // Libération des différentes variables // FStream.Free; Inherited Destroy; end; // -------------------------------------------------------- // Procedure interne de gestion des propriétés published // -------------------------------------------------------- procedure TDDUtilWord.SetModelDir(const Value: String); // Verification de l'emplacement des modeles begin if RightStr(Value,1)<>'\' then fModelDir := Value + '\' else fModelDir := Value; end; procedure TDDUtilWord.SetFileDir(const Value: String); // Verification de l'emplacement des fichiers begin if RightStr(Value,1)<>'\' then fFileDir := Value + '\' else fFileDir := Value; end; procedure TDDUtilWord.SetPictDir(const Value: String); // Verification de l'emplacement des images begin if RightStr(Value,1)<>'\' then fPictDir := Value + '\' else fPictDir := Value; end; procedure TDDUtilWord.SetWordVisible(const Value: Boolean); // Affichage ou cachage de Word begin if NumInstance = 0 then Exit; WordAppli[NumInstance].Visible := Value; // forcer l'affcihage de Word fWordVisible := Value; end; // -------------------------------------------------------- // Procedure privée // -------------------------------------------------------- procedure TDDUtilWord.SetConnect; // Procedure de connection automatique begin Inc(NumInstance); WordAppli[NumInstance] := CreateOleObject('Word.Application'); WordAppli[NumInstance].Visible := WordVisible; // WordAppli[NumInstance] := GetActiveOleObject('Word.Application'); // WordAppli[NumInstance].Visible := WordVisible; fCountImg := 1; // Initialisation du compteur d'image { // Options possibles WordAppli[NumInstance].Options.CheckSpellingAsYouType := False; // Orthographe WordAppli[NumInstance].Options.CheckGrammarAsYouType := False; // Grammaire WordAppli[NumInstance].ScreenUpdating:=False; // Mise à jour de l'affichage WordAppli[NumInstance].DisplayAlerts:=wdAlertsMessageBox; // aucune alerte Word } end; // -------------------------------------------------------- // Procedure publique // -------------------------------------------------------- function TDDUtilWord.PrintFile(FlagPrev : Boolean) : Boolean; // Fonction qui imprime le fichier // FlagPrev : si Vrai => lance la prévisualisation // Retour : renvoi Vrai si l'impression s'est bien déroulée begin try if not FlagPrev then WordAppli[NumInstance].ActiveDocument.PrintOut(EmptyParam,EmptyParam, EmptyParam, // wdPrintAllDocument, EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam, EmptyParam, // wdPrintAllPages, EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam) else begin WordAppli[NumInstance].ActiveDocument.PrintPreview; WordAppli[NumInstance].Visible := True; // forcer l'affcihage de Word end; Result := True; except Result := False; end; end; function TDDUtilWord.InsertEntetePied(Texte : String; Head : Boolean) : Boolean; // Fonction qui insere une entete // Texte : texte de l'entete // Retour : renvoi Vrai si l'entete a bien été insérée begin try if Head then DocWord[NumInstance].ActiveWindow.ActivePane.View.SeekView := wdSeekCurrentPageHeader else DocWord[NumInstance].ActiveWindow.ActivePane.View.SeekView := wdSeekCurrentPageFooter; WordAppli[NumInstance].selection.font.size := 8; WordAppli[NumInstance].Selection.TypeText(Texte); DocWord[NumInstance].ActiveWindow.ActivePane.View.SeekView := wdSeekMainDocument; Result := True; except Result := False; DocWord[NumInstance].ActiveWindow.ActivePane.View.SeekView := wdSeekMainDocument; end; DocWord[NumInstance].ActiveWindow.ActivePane.View.SeekView := wdSeekMainDocument; end; function TDDUtilWord.Replace(ListRech, ListRemp : TStrings) : Boolean; // Fonction qui remplace toutes les occurences des chaines d'une liste par une autres // ListRech : Liste des chaines a rechercher // ListRemp : Liste des chaines a remplacer // Retour : renvoi Vrai si le remplacement s'est correctement effectué const CstStrLong = '#S_u_I_t_E_#'; TailleBuff = 240; var MaZone : Variant; ZoneEntete : Variant; ZonePied : Variant; ZoneFiPied : Variant; ZoneFiEntete : Variant; FZoneEntete : Boolean; FZonePied : Boolean; FZoneFiEntete : Boolean; FZoneFiPied : Boolean; SRech, SRemp : OLEVariant; // chaine courte de remplacement i,j : Integer; NbRemp : Integer; // Nombre d'élément de remplacement Segment : Integer; // Nombre de recherche pour une ligne de remplacement (chaine longue) StrTotRemp : String; // Chaine longue de remplacement begin NbRemp := ListRemp.Count - 1; try MaZone := DocWord[NumInstance].Range(0,0); // Initialsiation des zone d'entet et de pied de page FZoneFiEntete := GetExistsZone(wdFirstPageHeaderStory); if FZoneFiEntete then ZoneFiEntete := WordAppli[NumInstance].ActiveDocument.StoryRanges.Item(wdFirstPageHeaderStory); FZoneEntete := GetExistsZone(wdPrimaryHeaderStory); if FZoneEntete then ZoneEntete := WordAppli[NumInstance].ActiveDocument.StoryRanges.Item(wdPrimaryHeaderStory); FZoneFiPied := GetExistsZone(wdFirstPageFooterStory); if FZoneFiPied then ZoneFiPied := WordAppli[NumInstance].ActiveDocument.StoryRanges.Item(wdFirstPageFooterStory); FZonePied := GetExistsZone(wdPrimaryFooterStory); if FZonePied then ZonePied := WordAppli[NumInstance].ActiveDocument.StoryRanges.Item(wdPrimaryFooterStory); if Assigned(FOnRempProgress) then FOnRempProgress(Self, 0, ListRech.Count-1); for i := 0 to ListRech.Count-1 do begin SRech := ListRech[i]; if i <= NbRemp then StrTotRemp := ListRemp[i] else StrTotRemp := ''; // Gestion des retours chariots StrTotRemp := StringReplace(StrTotRemp, #13, '^p', [rfReplaceAll]); StrTotRemp := StringReplace(StrTotRemp, #10, '', [rfReplaceAll]); // Gestion des chaines de remplacement longue (>255= => tronçonage en 240 j := 0; Segment := Length(StrTotRemp) DIV TailleBuff; // pour tenir compte du mot de remplacement Repeat if j = Segment then SRemp := MidStr(StrTotRemp, j*TailleBuff, TailleBuff) else SRemp := MidStr(StrTotRemp, j*TailleBuff, TailleBuff) + CstStrLong; MaZone.Find.Execute(SRech,True,True,False,False,False,True,wdFindContinue,Emptyparam, SRemp, wdReplaceAll); // Entetes et Pieds de page if FZoneFiEntete then begin ZoneFiEntete.Find.ClearFormatting; ZoneFiEntete.Find.Replacement.ClearFormatting; ZoneFiEntete.Find.Execute(SRech,True,True,False,False,False,True,wdFindContinue,Emptyparam, SRemp, wdReplaceAll); end; if FZoneEntete then begin ZoneEntete.Find.ClearFormatting; ZoneEntete.Find.Replacement.ClearFormatting; ZoneEntete.Find.Execute(SRech,True,True,False,False,False,True,wdFindContinue,Emptyparam, SRemp, wdReplaceAll); end; if FZoneFiPied then begin ZoneFiPied.Find.ClearFormatting; ZoneFiPied.Find.Replacement.ClearFormatting; ZoneFiPied.Find.Execute(SRech,True,True,False,False,False,True,wdFindContinue,Emptyparam, SRemp, wdReplaceAll); end; if FZonePied then begin ZonePied.Find.ClearFormatting; ZonePied.Find.Replacement.ClearFormatting; ZonePied.Find.Execute(SRech,True,True,False,False,False,True,wdFindContinue,Emptyparam, SRemp, wdReplaceAll); end; SRech := CstStrLong; Inc(j); until j > Segment; if Assigned(FOnRempProgress) then FOnRempProgress(Self, i, ListRech.Count-1); end; Result := True; except Result := False; end; end; function TDDUtilWord.CloseFile(FlagSave, FlagCloseWord : Boolean): Boolean; // Fonction qui ferme le ficher en traitement // FlagSave : si Vrai => sauvegarde des modif, si Faux => pas de sauvegarde // FlagCloseWord : si Vrai => fermeture de word, si Faux => laisser word ouvert // Retour : renvoi Vrai si le fichier est coorectement ferme begin try if not FlagCloseWord then DocWord[NumInstance].Close(FlagSave) else begin WordAppli[NumInstance].Quit(FlagSave); WordAppli[NumInstance] := unassigned; end; Dec(NumInstance); Result := True; except if fAffMessage then MessageDlg('Problème recontré lors de la fermeture de Word' + #13 + 'Sans doute Word est déjà fermé manuellement', mtWarning, [mbOk], 0); Result := False; end; end; function TDDUtilWord.CloseAllWord(FlagSave : Boolean) : boolean; // Fonction fermant toutes les sessions de word ouverte par le programme // FlagSave : si Vrai => sauvegarde des modif, si Faux => pas de sauvegarde // Retour : renvoi Vrai si le fichier est coorectement ferme // Message d'information et fermeture systématique de tous les Word car : // Ouverture d'un word utilisateur, puis lancement de OpenFile, puis CloseAllWord => le word utilisteur lancé reste // Lancement de OpenFile, puis ouverture d'un Word utilisateur, puis ClosAllWord => le Word utilisateur se ferme ! var i : Integer; begin Result := False; if fAffMessage then if Messagedlg('Attention ! le programme va fermer toutes les session Word ouverte' + #13 + 'Voulez-vous continuer ?', mtConfirmation, [mbYes, mbNo],0) = mrNo then Exit; try for i := 1 to NumInstance do begin WordAppli[i].Quit(FlagSave); WordAppli[i] := unassigned; end; NumInstance := 0; Result := CloseSession; // fermeture de toutes les session trainant => inutile except Result := False; end; end; function TDDUtilWord.CloseSession: Boolean; // Fonction fermant toutes les sessions de word traiant dans le system // FlagSave : si Vrai => sauvegarde des modif, si Faux => pas de sauvegarde // Retour : renvoi Vrai si le fichier est coorectement ferme Var i : Integer; h : Integer; Te32 : TThreadEntry32; me32 : TProcessEntry32; listHandle : Tlist; function EnumThreadWindowProc(H:THandle;Param:Pointer):Bool;Stdcall; begin PostMessage(H,WM_CLOSE,0,0); Result:=True; end; begin Result := False; ListHandle := TList.Create; try // Création d'un image de la liste actuelle des process h := CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS,0); Me32.dwSize := sizeof(Me32); Try If Process32First(h,Me32) Then Repeat if Me32.szExeFile = 'WINWORD.EXE' then ListHandle.Add(Pointer(Me32.th32ProcessID)); Until Not Process32Next(h,Me32); finally CloseHandle(h); end; // Fermeture des process associés for i := 0 to ListHandle.Count -1 do begin h := CreateToolHelp32Snapshot(TH32CS_SNAPTHREAD,0); Te32.dwSize := SizeOf(Te32); if not Thread32First(h,Te32) then RaiseLastOSError else repeat if Te32.th32OwnerProcessID= THandle(ListHandle.Items[i]) then EnumThreadWindows(Te32.th32ThreadID,@EnumThreadWindowProc,0); until not Thread32Next(h,Te32); CloseHandle(h); Result := True; end; except ListHandle.Free; Result := False; end; ListHandle.Free; end; function TDDUtilWord.OpenFile(FileName : String): Boolean; // Fonction qui ouvre le ficher "FileName" en utilisant la propriete FileDir // FileName : Nom du fichier à ouvrir // Retour : renvoi Vrai si le fichier est ouvert // Open(FileName,ConfirmConversions,ReadOnly, AddToRecentFiles,PasswordDocument,PasswordTemplate // Revert,WritePasswordDocument,WritePasswordTemplate,Format,Encoding,Visible) var FicName : String; Visible : OleVariant; begin SetConnect; // Ouverture du lien vers Word si necessaire Visible := fWordVisible; // Afficher la fenetre Word si besoin FicName := fFileDir + FileName; if not FileExists(FicName) then begin Result := False; if fAffMessage then MessageDlg('Document non trouvé' + #13 + 'Emplacement : "' + fFileDir + '"' + #13 + 'Fichier : "' + FileName + '"', mtWarning, [mbOk], 0); end else begin try DocWord[NumInstance] := WordAppli[NumInstance].Documents.Open(FicName); fFileName := FileName; Result := True except Result := False; end; end; end; function TDDUtilWord.SaveFile(FileName : String; FlagBox : Boolean) : Boolean; // Fonction qui sauve les modifs du fichier en cours // FileName : Nom du fichier à sauvegarder (si = '' => pas de changement de nom) // FlagBox : Si Vrai => affichage de la boite dialogue // Retour : renvoi Vrai si le fichier est sauver // Open(FileName,ConfirmConversions,ReadOnly, AddToRecentFiles,PasswordDocument,PasswordTemplate // Revert,WritePasswordDocument,WritePasswordTemplate,Format,Encoding,Visible) begin Result := False; if not DirectoryExists(fFileDir) then Exit; try if FlagBox then begin // sauvegarde avec la boite de dialogue if FileName = '' then SaveDialog1.FileName := fFileName // nom d'origine else SaveDialog1.FileName := FileName; // nouveau nom if SaveDialog1.Execute then begin DocWord[NumInstance].SaveAs(SaveDialog1.FileName); fFileName := SaveDialog1.FileName; Result := True; end; end else begin // pas d'ouverture de la boite de dialogue de sauvegarde if FileName = '' then DocWord[NumInstance].Save // nom d'origine else DocWord[NumInstance].SaveAs(FileName); // nouveau nom Result := True; end; except Result := False; end; end; function TDDUtilWord.OpenModel(ModelName : String): Boolean; // Fonction qui ouvre un nouveau fichier selon le modele "ModelName" en utilisant la propriete ModelDir // ModelName : Nom du modele a utiliser // Retour : renvoi Vrai si le fichier est ouvert var FicName, AsModel: OleVariant; begin SetConnect; // Ouverture du lien vers Word si necessaire WordAppli[NumInstance].Visible:= fWordVisible; // Afficher la fenetre Word si besoin FicName := fModelDir + ModelName; if not FileExists(FicName) then begin Result := False; if fAffMessage then MessageDlg('Modèle non trouvé' + #13 + 'Emplacement : "' + fModelDir + '"' + #13 + 'Fichier : "' + ModelName + '"', mtWarning, [mbOk], 0); end else begin try AsModel := False; DocWord[NumInstance] := WordAppli[NumInstance].Documents.Add(FicName, AsModel, EmptyParam, EmptyParam); fFileName := 'Document1.doc'; Result := True; except Result := False; end; end; end; function TDDUtilWord.NewPicture(PictureName : String; Left, Top, Width, Height : Integer) : Boolean; // Fonction qui insere une l'image PictureName à l'emplacment et à la taille designé // PictureName : Nom de l'image a inserer // Left : Point à gauche // Top : Point en haut // Width : Largeur de l'image // Height : Hauteur de l'image // Stretch : Vrai => l'imùage occupera toute la zone, Faux => les proportion de l'image seront conservée // Retour : renvoi Vrai si l'image a pu etre inseree begin try DocWord[NumInstance].Shapes.AddTextbox(TaRightJustify, Left, Top, Width, Height); inc(fCountImg); Result := InsertPicture(PictureName, fCountImg); except Result := False; end; end; function TDDUtilWord.InsertPicture(PictureName : String; NumZone : Integer) : Boolean; // Fonction qui insere une l'image PictureName à l'emplacment designé // PictureName : Nom de l'image a inserer // NumZone : Numero de la Zone ou de la forme dans laquelle insere l'image // Stretch : Vrai => l'imùage occupera toute la zone, Faux => les proportion de l'image seront conservée // Retour : renvoi Vrai si l'image a pu etre inseree begin try DocWord[NumInstance].shapes.item(NumZone).Select; WordAppli[NumInstance].Selection.ShapeRange.Line.Visible := False; WordAppli[NumInstance].Selection.ShapeRange.Fill.Visible := True; WordAppli[NumInstance].Selection.ShapeRange.Fill.Solid; WordAppli[NumInstance].Selection.ShapeRange.Fill.Transparency := 0; WordAppli[NumInstance].Selection.ShapeRange.Fill.UserPicture(PictureName); DocWord[NumInstance].Shapes.Item(fCountImg).Select; Result := True; except Result := False; end; end; function TDDUtilWord.InsertTabPicture(PictureName, CodeChaine: String): Boolean; // Fonction d'insertion d'une image dans une cellule de tableau // PictureName : Chemin et Nom de l'image a inserer // CodeChaine : Texte à trouver dans la cellule désignant l'emplacement d'insertion // Pour que l'image s'adapte à la cellule, il faut paramétrer les propriétée du tableau // pour qu'il n'y ai aucun ajustement automatique (dimension "préféré") Var Tableau : Variant; // Table i : Integer; NbTab : Integer; TabNum, RowNum, ColNum : Integer; myRows, myCols : Integer; CurrentRow : Variant; //Row; CelluleText : String; FinRech : Boolean; begin Result := False; TabNum := 0; RowNum := 0; ColNum := 0; // recherche de la cellule où faire l'insertion try NbTab := DocWord[NumInstance].Tables.Count; // Nombre de tableau dans le fichier if NbTab = 0 then Exit; FinRech := False; i := 1; Repeat Tableau := DocWord[NumInstance].Tables.Item(i); // Pointage sur le nème tableau for myRows := 1 to Tableau.Rows.Count do begin CurrentRow := Tableau.Rows.Item(myRows); // Parcours de lignes for myCols := 1 to CurrentRow.Cells.Count do begin CelluleText := Tableau.Cell(myRows,myCols).Range.Text; // parcours des colonnes CelluleText := StringReplace(CelluleText,#$D, '', [rfReplaceAll]); // supprime les RC CelluleText := StringReplace(CelluleText, #$7, '', [rfReplaceAll]); // Supoprime les Tab if CelluleText = CodeChaine then begin // Code de l'insertion trouvé TabNum := i; RowNum := myRows; ColNum := myCols; FinRech := True; end; end end; if i = NbTab then FinRech := True else inc(i); until FinRech; if TabNum > 0 then begin // Insertion de l'image et suppression du code DocWord[NumInstance].Tables.Item(TabNum).Cell(RowNum, ColNum).Range.Select; if FileExists(PictureName) then WordAppli[NumInstance].Selection.InlineShapes.AddPicture(PictureName, False, True); DocWord[NumInstance].Range(0,0).Find.Execute(CodeChaine,True,True,False,False,False,True,wdFindContinue, Emptyparam, '', wdReplaceAll, EmptyParam,EmptyParam,EmptyParam,EmptyParam); end; Result := True; except Result := False; end; end; function TDDUtilWord.InsereTab(CodeEmpl : String; NbRow, NbCol, RHeight, CWidth : Integer; ListRemp : TStrings; FCadre: Boolean): Boolean; // Fonction d'insertion d'un tableau var Tableau : Variant; MaZone : Variant; SRech : OLEVariant; myRows, myCols : Integer; begin MaZone := DocWord[NumInstance].Range(0,0); SRech := CodeEmpl; MaZone.Find.Execute(SRech,False,False,False,False,False,True,wdFindStop, Emptyparam, EmptyParam, EmptyParam); MaZone.Select; Tableau := DocWord[NumInstance].Tables.Add(WordAppli[NumInstance].Selection.Range, NbRow, NbCol); // Description des bordures if FCadre then begin Tableau.Borders.Item(wdBorderLeft).LineStyle := wdLineStyleSingle; Tableau.Borders.Item(wdBorderLeft).LineWidth := wdLineWidth050pt; Tableau.Borders.Item(wdBorderLeft).Color := wdColorAutomatic; Tableau.Borders.Item(wdBorderRight).LineStyle := wdLineStyleSingle; Tableau.Borders.Item(wdBorderRight).LineWidth := wdLineWidth050pt; Tableau.Borders.Item(wdBorderRight).Color := wdColorAutomatic; Tableau.Borders.Item(wdBorderTop).LineStyle := wdLineStyleSingle; Tableau.Borders.Item(wdBorderTop).LineWidth := wdLineWidth050pt; Tableau.Borders.Item(wdBorderTop).Color := wdColorAutomatic; Tableau.Borders.Item(wdBorderBottom).LineStyle := wdLineStyleSingle; Tableau.Borders.Item(wdBorderBottom).LineWidth := wdLineWidth050pt; Tableau.Borders.Item(wdBorderBottom).Color := wdColorAutomatic; Tableau.Borders.Item(wdBorderHorizontal).LineStyle := wdLineStyleSingle; Tableau.Borders.Item(wdBorderHorizontal).LineWidth := wdLineWidth050pt; Tableau.Borders.Item(wdBorderHorizontal).Color := wdColorAutomatic; Tableau.Borders.Item(wdBorderVertical).LineStyle := wdLineStyleSingle; Tableau.Borders.Item(wdBorderVertical).LineWidth := wdLineWidth050pt; Tableau.Borders.Item(wdBorderVertical).Color := wdColorAutomatic; Tableau.Borders.Item(wdBorderDiagonalDown).LineStyle := wdLineStyleNone; Tableau.Borders.Item(wdBorderDiagonalUp).LineStyle := wdLineStyleNone; Tableau.Borders.Shadow := False; end; // Largeur des colonnes Tableau.PreferredWidthType := wdPreferredWidthPoints; Tableau.PreferredWidth := CWidth; // Hauteur des lignes for myRows := 1 to Tableau.Rows.Count do begin Tableau.Rows.Item(myRows).HeightRule := wdRowHeightAtLeast; Tableau.Rows.Item(myRows).Height := RHeight; if ListRemp <> nil then for myCols := 1 to Tableau.Rows.Item(myRows).Cells.Count do begin Tableau.Cell(myRows, MyCols).Range.Select; WordAppli[NumInstance].Selection.Font.Name := 'Times New Roman'; WordAppli[NumInstance].Selection.Font.Bold := False; WordAppli[NumInstance].selection.Font.Size := 12; WordAppli[NumInstance].Selection.ParagraphFormat.Alignment := wdAlignParagraphLeft; if ListRemp.Count > ((myRows-1)*Tableau.Rows.Item(myRows).Cells.Count)+(myCols-1) then WordAppli[NumInstance].Selection.TypeText(ListRemp[((myRows-1)*Tableau.Rows.Item(myRows).Cells.Count)+(myCols-1)]); end; end; Tableau.Spacing := 0; Tableau.AllowPageBreaks := True; Tableau.AllowAutoFit := False; Result := True; // Selection.Range.Cells(1).VerticalAlignment := wdCellAlignVerticalCenter; // Tableau.TopPadding := CentimetersToPoints(0); // Tableau.BottomPadding := CentimetersToPoints(0); // Tableau.LeftPadding := CentimetersToPoints(0.19); // Tableau.RightPadding := CentimetersToPoints(0.19); end; function TDDUtilWord.GetExistsZone(Zone : Integer) : Boolean; // fonction indiquant si la zone existe (entete ou pied de page) begin if FModeDev then begin Result := False; Exit; end; // pour éviter les message d'erreurs try WordAppli[NumInstance].ActiveDocument.StoryRanges.Item(Zone); Result := True; except Result := False; end; end; end.