(* 
Quell- und Zieldokument sind geöffnet ... sonst nix ... 
Anzahl der Seiten ist identisch ... 
Alle (wirklich alle) Elemente der Quellseite werden kopiert ... 
 
*) 
 
property destDoc : "Projekt2" --Name des Zieldokuments 
 
--Namen des Quelldokus ermitteln 
tell application "QuarkXPress" 
	activate 
	set openDocs to every document 
	if (count of openDocs) is 2 then 
		repeat with i from 1 to count of openDocs 
			set theName to name of item i of openDocs 
			if theName is not destDoc then my getLayerContent(theName) 
		end repeat 
	end if 
end tell 
 
--alle Objekte einer Seite des Quelldokus ermitteln und an move2Dest übergeben  
on getLayerContent(theName) 
	tell application "QuarkXPress" 
		set thePages to every page of document theName 
		tell document theName 
			repeat with j from 1 to count of thePages 
				set actualPage to item j of thePages 
				set thePageItems to every generic box of actualPage 
				my move2Dest(thePageItems, theName, j) 
			end repeat 
		end tell 
	end tell 
end getLayerContent 
 
-- Falls nicht vorhanden: neuen Layer im Zieldokument erstellen (name = Dokumentname des Quelldokus) 
-- alle Objekte der Liste thePageItems auf diese Ebene auf der gleichen Seite kopieren  
on move2Dest(thePageItems, theName, pageNbr) 
	tell application "QuarkXPress" 
		tell document destDoc 
			 
			if not (exists layer theName) then 
				set DestLayer to make layer at beginning with properties {name:theName} 
			end if 
		end tell 
		 
		repeat with f from 1 to count of thePageItems 
			copy item f of thePageItems to end of layer theName of page pageNbr of document destDoc 
		end repeat 
		 
	end tell 
end move2Dest 

tell application "QuarkXPress" 
	activate 
	tell document 1 
		set _SB to {} 
		set _EB to every text box 
		repeat with i from 1 to count of _EB 
			set _TB to item i of _EB 
			if previous text box of _TB is null and box wraps of _TB is true then set end of _SB to _TB 
		end repeat 
		my label_TF(_SB) 
	end tell 
end tell 
 
on label_TF(_SB) 
	repeat with j from 1 to count of _SB 
		tell application "QuarkXPress" 
			activate 
			tell document 1 
				 
				set the_SB to item j of _SB 
				set name of the_SB to (j as text) 
				set counter to 0 
				my setName(the_SB, j, counter) 
			end tell 
		end tell 
		 
	end repeat 
	 
end label_TF 
 
on setName(the_SB, j, counter) 
	tell application "QuarkXPress" 
		activate 
		tell document 1 
			set counter to counter + 1 
			set _NB to next text box of the_SB 
			set name of _NB to (j as text) & "_" & (counter as text) 
			if next text box of _NB is not null then my setName(_NB, j, counter) 
		end tell 
	end tell 
end setName 

global workLayer 
 
tell application "QuarkXPress" 
	activate 
	tell document 1 
		set theLayers to name of every layer 
		set workLayer to item 1 of (choose from list theLayers) 
		set _TB to every text box of layer workLayer whose name is not null and name does not contain "_" 
		repeat with i from 1 to count of _TB 
			set _SB to item i of _TB 
			set baseName to name of _SB 
			set _NB to (every text box of layer workLayer whose name is (baseName & "_1")) 
			set next text box of _SB to item 1 of _NB 
			set counter to 1 
			my setTextFlow(item 1 of _NB, counter, baseName) 
			 
		end repeat 
	end tell 
end tell 
 
on setTextFlow(_aTextBox, counter, baseName) 
	try 
		tell application "QuarkXPress" 
			activate 
			tell document 1 
				set counter to counter + 1 
				set nextBoxList to (every text box of layer workLayer whose name is (baseName & "_" & (counter as text))) 
				set next text box of _aTextBox to (item 1 of nextBoxList) 
				my setTextFlow(item 1 of nextBoxList, counter, baseName) 
				 
			end tell 
		end tell 
	end try 
end setTextFlow