Automation de word avec vfp

Commenter

Contenu du snippet

Nécessite VFP >= 8
Facilite l'automation de Word
Ferme automatiquement les documents ouverts et Word
Donne la main à l'utilisateur pour modifier un document et reprend la main quand il a terminé
Convertit un document Word dans un autre format
Peut donner des idées pour aller plus loin dans l'automation de Word avec VFP

Source / Exemple : 




  •  =====================================

	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 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


    	
  •  =====================================

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (AbaqueInside)