* =====================================
DEFINE CLASS abWord as Relation
* =====================================
&& Read/write
cDefaultFolder = Sys(5) + Addbs(Curdir()) && Dossier par défaut
&& Read only
iVersion = 0
&& Hidden
HIDDEN ARRAY aFileConverters[1]
HIDDEN oWord
oWord = NULL && AS Word.Application
* -------------------------------------
PROTECTED PROCEDURE Init && Instancie Word.Application
LOCAL loExcept, llResult
TRY
this.oWord = CreateObject('Word.Application')
WITH m.this.oWord as Word.Application
.DisplayAlerts = 0 && wdAlertsNone
this.Init_aFileConverters
ENDWITH
llResult = .T.
CATCH TO loExcept
ENDTRY
RETURN m.llResult && si .F., l'objet n'est pas créé
* -------------------------------------
HIDDEN PROCEDURE iVersion_Access
RETURN Int(Val(this.oWord.Version)) && 8: Word 97, etc.
* -------------------------------------
HIDDEN PROCEDURE Init_aFileConverters && Tabule les convertisseurs de fichiers
IF .FileConverters.Count > 0
LOCAL lnConv, loConv as Word.FileConverter
DIMENSION this.aFileConverters[.FileConverters.Count, 5]
FOR lnConv = 1 TO .FileConverters.Count
loConv = .FileConverters(m.lnConv)
WITH loConv as Word.FileConverter
this.aFileConverters[m.lnConv, 1] = .ClassName
this.aFileConverters[m.lnConv, 2] = .FormatName
this.aFileConverters[m.lnConv, 3] = .Extensions
this.aFileConverters[m.lnConv, 4] = Iif(.CanOpen, .OpenFormat, wdOpenFormatAuto)
this.aFileConverters[m.lnConv, 5] = Iif(.CanSave, .SaveFormat, wdFormatDocument)
ENDWITH
NEXT
ENDIF
* -------------------------------------
PROCEDURE FileConvertersDisplay && Affiche les convertisseurs de fichiers
LOCAL lnConv
FOR lnConv = 1 TO Alen(m.this.aFileConverters, 1)
? this.aFileConverters[m.lnConv, 1];
+ Chr(9) + this.aFileConverters[m.lnConv, 2];
+ Chr(9) + this.aFileConverters[m.lnConv, 3];
+ Chr(9) + Transform(this.aFileConverters[m.lnConv, 4]);
+ Chr(9) + Transform(this.aFileConverters[m.lnConv, 5])
NEXT
* -------------------------------------
PROTECTED PROCEDURE wdFormat && Code format d'ouverture / sauvegarde
LPARAMETERS ;
tcClass,; && Classe de conversion de document (cf. this.oDoc)
tlSave && [.F.] .T.: format de sauvegarde ; .F. : format d'ouverture
tlSave = Vartype(m.tlSave) == 'L' AND m.tlSave
LOCAL lnConv, lnResult && Code format
lnResult = Iif(m.tlSave, wdFormatDocument, wdOpenFormatAuto) && Code par défaut
IF Vartype(m.tcClass) == 'C' AND NOT Empty(m.tcClass)
lnConv = Ascan(m.this.aFileConverters, m.tcClass, 1, -1, 1, 15)
IF m.lnConv > 0
lnResult = this.aFileConverters[m.lnConv, Iif(m.tlSave, 5, 4)]
ENDIF
ENDIF
RETURN m.lnResult
* -------------------------------------
HIDDEN PROCEDURE cFullPath && Chemin complet d'un fichier
LPARAMETERS tcFile
RETURN ICase(.F., '';
, File(m.tcFile), FullPath(m.tcFile);
, Directory(JustPath(m.tcFile)), FullPath(JustPath(m.tcFile)) + JustFname(m.tcFile);
, this.cDefaultFolder + JustFname(m.tcFile))
* -------------------------------------
FUNCTION oDoc && Ouvre un document et fournit sa référence
LPARAMETERS ;
tcFileSrce,; && Document source
tcClassSrce,; && Classe de conversion si l'extension est ambiguë
tcPassWord && [''] mot de passe à l'ouverture
tcPassWord = Iif(Vartype(m.tcPassWord) == 'C', m.tcPassWord, Space(0))
LOCAL llResult, lnFormat, loExcept as Exception, loResult AS Word.Document
loResult = NULL
llResult = Vartype(m.tcFileSrce) == 'C' AND File(m.tcFileSrce)
ASSERT m.llResult MESSAGE Textmerge([<<Program()>> - Le fichier <<m.tcFileSrce>> est introuvable])
IF m.llResult
tcFileSrce = FullPath(m.tcFileSrce)
lnFormat = this.wdFormat(m.tcClassSrce)
WITH this.oWord.Documents as Word.Documents
TRY && Abaque > ThN : à cause d'un pb d'installation Word 97, la première ouverture envoie un message d'erreur 'base de registre ...'
loResult = .Open(m.tcFileSrce, .F., .F., .F., m.tcPassWord, '', .F., m.tcPassWord, '', m.lnFormat)
CATCH TO loExcept
ENDTRY
loResult = Nvl(m.loResult, .Open(m.tcFileSrce, .F., .F., .F., m.tcPassWord, '', .F., m.tcPassWord, '', m.lnFormat))
* Masquer le document
IF Vartype(m.loResult) == 'O'
loResult.Application.Visible = .F.
ENDIF
ENDWITH
ENDIF
RETURN m.loResult
* -------------------------------------
HIDDEN FUNCTION oDocDefault && Document par défaut
LPARAMETERS toDoc AS Word.Document, tnDoc && @ n° de document
LOCAL llResult
toDoc = ICase(.F., NULL;
, Vartype(m.toDoc) == 'O', m.toDoc;
, Type('this.oWord.Documents(1)') == 'O', this.oWord.Documents(1);
, NULL)
llResult = Vartype(m.toDoc) == 'O'
ASSERT m.llResult MESSAGE Textmerge([<<Program()>> - Aucun document n'est ouvert dans Word ...])
IF m.llResult
* Trouver le n° du document
FOR tnDoc = 1 TO this.oWord.Documents.Count
IF this.oWord.Documents(m.tnDoc).FullName == m.toDoc.FullName && this.oWord.Documents(m.tnDoc) = m.toDoc ne marche pas en automation
EXIT
ENDIF
NEXT
ENDIF
RETURN m.toDoc
* -------------------------------------
PROCEDURE Convert && Sauve un document dans un autre format (si supporté)
LPARAMETERS ;
tcFileDest,; && @ Adresse du fichier destination
tcClassDest,; && Classe de conversion si l'extension est ambiguë
tcPassWord,; && [''] mot de passe
toDoc && [Documents(1)] Référence au document source
tcPassWord = Iif(Vartype(m.tcPassWord) == 'C', m.tcPassWord, Space(0))
LOCAL loException, lnFormat, llResult
toDoc = this.oDocDefault(m.toDoc)
llResult = Vartype(m.toDoc) == 'O'
IF m.llResult
tcFileDest = this.cFullPath(m.tcFileDest)
lnFormat = this.wdFormat(m.tcClassDest, .T.)
TRY && Abaque ThN : mon Word 97 me fait des misères
llResult = Nvl(toDoc.SaveAs(m.tcFileDest, m.lnFormat, .F., m.tcPassWord), .F.)
CATCH TO loException
ENDTRY
llResult = m.llResult OR Nvl(toDoc.SaveAs(m.tcFileDest, m.lnFormat, .F., m.tcPassWord), .F.)
ENDIF
RETURN m.llResult
* -------------------------------------
PROCEDURE OpenConvert && Ouvre un document et le convertit dans un autre format (si supporté)
LPARAMETERS ;
tcFileSrce,; && Document source
tcClassSrce,; && Classe de conversion si l'extension est ambiguë
tcFileDest,; && @ Adresse du fichier destination
tcClassDest,; && Classe de conversion si l'extension est ambiguë
tcPassWord && [''] mot de passe
LOCAL loDoc
loDoc = this.oDoc(m.tcFileSrce, m.tcClassSrce, m.tcPassWord)
RETURN Vartype(m.loDoc) == 'O';
AND this.Convert(m.tcFileDest, m.tcClassDest, m.tcPassWord, m.loDoc)
* -------------------------------------
PROCEDURE UserEdit && Donne la main à l'utilisateur pour éditer un document
LPARAMETERS toDoc as Word.Document && [Documents(1)] Référence au document source
LOCAL lnDoc, llResult
toDoc = this.oDocDefault(m.toDoc, @lnDoc)
llResult = Vartype(m.toDoc) == 'O'
IF m.llResult
* this.PreventClose && sinon ça génère des erreurs && en fait ça marche presque à tous les coups sur Word 97
toDoc.Activate
WITH m.this.oWord as Word.Application
.ActiveWindow.View.Type = 1 && wdNormalView
.Top = Max(.Top, 0)
.Visible = .T.
.Activate
* Afficher un message && pas trouvé comment faire :-(
&& [Enregistrez et fermez le document pour revenir à la console]
* Attendre que l'utilisateur ait fini ses modifications
DO WHILE Type(Textmerge('.Documents(<<m.lnDoc>>)')) == 'O'
Inkey(.5)
ENDDO
ENDWITH
IF Type('this.oWord.Application') == 'O' && L'utilisateur peut avoir fermé Word par la X
this.oWord.Visible = .F.
ENDIF
ENDIF
RETURN m.llResult
* -------------------------------------
PROCEDURE PreventClose && Empêche de fermer Word && Mike Gagnon sur AtoutFox
DECLARE Integer FindWindow In user32 String lpClassName, String lpWindowName
DECLARE Integer GetSystemMenu In user32 Integer hWnd, Integer bRevert
DECLARE Integer RemoveMenu In user32 Integer hMenu, Integer nPosition, Integer wFlags
LOCAL lhWin, lhMenu, lnMenu
lhWin = FindWindow("OPUSApp", 0) &&"OPUSApp" est le nom de la Classe Word
lhMenu = GetSystemMenu(lhWin, 0)
FOR lnMenu = 6 TO 0 STEP -1
RemoveMenu(lhMenu, m.lnMenu, 1024) && MF_BYPOSITION
NEXT
this.oWord.Top = Max(this.oWord.Top, 0) && on ne peut plus bouger la fenêtre
* this.oWord.CommandBars('File').Controls('Quit').Enabled = .F. && ne marche pas
* -------------------------------------
PROCEDURE Destroy
IF Type('this.oWord.Documents') == 'O' && L'utilisateur peut avoir fermé Word par la X
IF this.oWord.Documents.Count > 0
LOCAL loDoc AS Word.Document
FOR EACH loDoc IN this.oWord.Documents
loDoc.Close(.F.) && no save
NEXT
ENDIF
this.oWord.Quit
ENDIF
* =====================================
ENDDEFINE && CLASS abWord
* =====================================
|
Retour à la liste
France
Fiche personnelle
Note des membres