Change the font in a Microsoft Word document

[Andrew_Hobson]

Hello,

I would need some help scripting Microsoft Word 2008.

I have lots of documents for which I need to replace one font with another. I don’t know where to start…

Example for my word document:

Some text in Helvetica in one paragraph.
Some text in Impact in one other paragraph.

I need to change only the paragraphs that are in Helvetica and change them in Helvetica Narrow.

My questions are:

1. How do you go thru each paragraph in a Word document (loop thu all paragraphs of a document)?
2. How can you say: If paragraph is in Helvetica, then change it to Helvetica Narrow?

Thanks for helping me out with this script. I am not yet a good AppleScript user but I need to automate this task because there is too many Word documents to do it by hand…

Andrew

[StefanK]

Hi,

MS Word has a powerful find and replacement function which is pretty well scriptable.
I got the basic script from Word 2004 AppleScript Scripting Guide

tell application "Microsoft Word"
	set myFind to find object of text object of active document
	clear formatting myFind
	set name of font object of myFind to "Helvetica"
	set content of myFind to ""
	clear formatting replacement of myFind
	set name of font object of replacement of myFind to "Helvetica Narrow"
	set content of replacement of myFind to ""
	execute find myFind replace replace all
end tell

[Andrew_Hobson]

Hello,

Thank you, your solution is simple and works great but…

1. I need to find text that is in the font “N Helvetica Narrow” and style Bold. and replace it with another font.

How to you specify the Bold style in the find command?

2. Is it possible to make this script as something you can drop onto it the Word document to transform?
   How would you do that?

Thanks for your help.

Andrew Hobson

[Andrew_Hobson]

Re-Hello,

It’s OK, I found the reply to question 1…

You can use “set bold of font object of myFind to true” and it works great.

But if someone could help my for question 2…

I need to drop on this AppleScript a folder in which there is some Word documents. If it could automatically go thru all the documents in the folder and apply these font changes, it would be great.

Any help please?

[Andrew_Hobson]

Hi to all,

Here is the script I was able to build to do my task. I inspired myself with the work of some other people…

My questions are the following:

When I drop files on the script, how can I reduce the selection to only “.doc” files.

Thanks for any comments or suggestion to make this a better script…

--[SCRIPT convertisseur batch doc to docx + font change]
(*
	Exécuter ce script ou déposer l'icône d'un dossier
	sur son icône (version application)
	ouvre les documents Microsoft Word ".doc" du dossier
	et les enregistreSous en fichier Office ".docx"
	dans le dossier "wasDOC_nowDOCX" sur le bureau.
	Il modifie la police de caractère aussi de certains éléments

	Andrew HOBSON le 26 mai 2010
	modifié le  ...
*)

property Stockage : "wasDOC_nowDOCX"

property theDocName : ""

property msg0 : "" -- globale
property msg99 : "" -- globale

property cheminDeStockage : "" -- globale

property nbDocsOuverts : 0 -- globale

-- ===========

(*
	deux lignes exécutées si on double clique
	sur l'icône du script application
*)

set msg00 to "Choisir un dossier ."

tell application "Finder"
	choose folder with prompt msg00
	set listeFichiers to every item in result whose name extension is "doc"
end tell

if (count of listeFichiers) = 0 then return

open listeFichiers

-- ==============================

on open (sel)
	
	(*
		sel contient une liste d'alias des éléments
		qu'on a déposés sur l'icône du script (la sélection)
	*)
	
	try
		if msg0 is "" then my prepareMessages()
		
		tell application "Microsoft Word"
			if "12." is not in (version as text) then error msg0 number 8000
			set nbDocsOuverts to (count each document)
		end tell -- to Microsoft Word
		
		set cheminDeStockage to my creeDossierDeStockage()
		
		repeat with elem in sel
			
			tell application "Microsoft Word"
				open elem as alias
				
				set theDocName to name of (info for elem as alias)
				set theDocName to cheminDeStockage & theDocName & "x"
				
				set myFind to find object of text object of active document
				clear formatting myFind
				set name of font object of myFind to "N Helvetica Narrow"
				set bold of font object of myFind to false
				set content of myFind to ""
				clear formatting replacement of myFind
				set name of font object of replacement of myFind to "Comic Sans MS"
				set content of replacement of myFind to ""
				execute find myFind replace replace all
				
				set myFind to find object of text object of active document
				clear formatting myFind
				set name of font object of myFind to "N Helvetica Narrow"
				set bold of font object of myFind to true
				set content of myFind to ""
				clear formatting replacement of myFind
				set name of font object of replacement of myFind to "Arial Unicode MS"
				set content of replacement of myFind to ""
				execute find myFind replace replace all
				
				save as active document file name theDocName file format format document
				close active document
			end tell
			
		end repeat
		
	on error MsgErr number NroErr
		if NroErr is not -128 then
			beep 2
			tell application ¬
				(path to frontmost application as string) to ¬
				display dialog "" & NroErr & " : " & MsgErr ¬
					with icon 0 ¬
					buttons {msg99} giving up after 20
		end if -- NroErr is.
		return
		
	end try
	
end open

-- ============= Routines

on creeDossierDeStockage()
	(*
		S'il n'existe pas, construit un dossier destination sur le bureau
	*)
	set cheminDuBureau to (path to desktop)
	if Stockage ends with ":" then set Stockage to ¬
		(text 1 thru -2 of Stockage) as text
	set cheminDeStockage_ to ¬
		"" & cheminDuBureau & Stockage & ":"
	try
		cheminDeStockage_ as alias
	on error
		(*
			cheminDeStockage n'existe pas, on le crée
		*)
		tell application "Finder" to ¬
			make new folder at cheminDuBureau ¬
				with properties {name:Stockage}
	end try
	return cheminDeStockage_
end creeDossierDeStockage

-- =============

on prepareMessages()
	set msg0 to "Ce script n'est pas compatible" & ¬
		return & "avec cette version de Microsoft Word." & return & ¬
		"Veuillez utiliser une version 12.0" & return & ¬
		"ou plus récente..."
	set msg99 to " Vu "
end prepareMessages

--[/SCRIPT]

[StefanK]

@Andrew_Hobson

When I drop files on the script, how can I reduce the selection to only “.doc” files.

.
repeat with elem in sel
	if name extension of (info for elem as alias) is "doc" then
		tell application "Microsoft Word"
			--- ...
			
			
			--- ...
		end tell
	end if
end repeat

.

[Andrew_Hobson]

Thank you Stephan for the reply.

I have 2 other questions:

1. What must I do for this script to react correctly if I drop a folder full of “.doc” files on it?
2. How must I write this script if I wanted to put the “font find & replace” in a subroutine?
3. Would you know why when I say “save as … file format format document” Word doesn’t change himself the extension from doc to docx. As I didn’t ask to “save as format document97”. The natural extension for Word 2008 is docx… I’m not sure of myself that the best way of doing it is just adding and “x” to the file name… What do you think?

Thanks foir the help.

Andrew

[StefanK]

There are 3 questions

I can’t answer question #3, because I don’t have Office 2008.
Here is the on open handler which can also handle folders and a find-and-replace subroutine.
I haven’t tested it, but it should work

on open sel
	
	(*
       sel contient une liste d'alias des éléments
       qu'on a déposés sur l'icône du script (la sélection)
   *)
	
	try
		if msg0 is "" then my prepareMessages()
		
		tell application "Microsoft Word"
			if "12." is not in (version as text) then error msg0 number 8000
			set nbDocsOuverts to (count each document)
		end tell -- to Microsoft Word
		
		set cheminDeStockage to my creeDossierDeStockage()
		
		repeat with elem in sel
			set {name extension:Ex, folder:Fo, package folder:Pa} to info for (elem as alias)
			if Fo and not Pa then
				tell application "Finder" to set fileList to files of elem
				repeat with oneFile in fileList
					if Ex is "doc" then processFile(oneFile)
				end repeat
			else
				if Ex is "doc" then processFile(elem)
			end if
		end repeat
		
	on error MsgErr number NroErr
		if NroErr is not -128 then
			beep 2
			tell application ¬
				(path to frontmost application as string) to ¬
				display dialog "" & NroErr & " : " & MsgErr ¬
					with icon 0 ¬
					buttons {msg99} giving up after 20
		end if -- NroErr is.
		return
		
	end try
end open

on processFile(theFile)
	tell application "Microsoft Word"
		open (theFile as alias)
		
		set theDocName to name of active document
		set theDocName to cheminDeStockage & theDocName & "x"
		my findAndReplace("N Helvetica Narrow", "Comic Sans MS", false)
		my findAndReplace("N Helvetica Narrow", "Arial Unicode MS", true)
		save as active document file name theDocName file format format document
		close active document
	end tell
end processFile

on findAndReplace(findFont, replaceFont, isBold)
	tell application "Microsoft Word"
		set myFind to find object of text object of active document
		clear formatting myFind
		set name of font object of myFind to findFont
		set bold of font object of myFind to isBold
		set content of myFind to ""
		clear formatting replacement of myFind
		set name of font object of replacement of myFind to replaceFont
		set content of replacement of myFind to ""
		execute find myFind replace replace all
	end tell
end findAndReplace

[Andrew_Hobson]

Hello StephanK,

You are correct, there was 3 questions and not 2… I must read my posts before clicking “Submit”…

Thanks a lot for your help. It is very much appreciated.

Can someone tell me if my method to convert a .doc to a .docx is correct?

Thanks to all in advance.

Andrew