| View previous topic :: View next topic |
| Author |
Message |
kam
General User
Joined: 25 Aug 2005
Posts: 6
|
 Posted: Thu Aug 25, 2005 5:16 am Post subject: Solved: removing linked sections from a master document |
 |
|
I need to convert a large number of master documents to Writer format, and I need to remove linked sections from each at the same time. From the UI, this is done by opening the document, clicking Format -> Sections, then clicking "Remove" in the dialog to replace each linked section with its contents.
I've modified the DocConverter macro (will give it back to the author when complete) so it converts sxg files (this part was easy). The "removeSections" sub is below; it successfully identifies and removes all the linked sections, but it is not so successful at inserting the contents of the files. I think I need to set the cursor position / anchor to the start of the section I just deleted, but I'm not sure how.
I'm not a basic programmer, so this is probably not as clear as it could be.
| Code: |
Sub removeSections()
Dim oSections 'Enumerator used to enumerate the text sections
Dim oSection 'The enumerated text section
Dim section as Long ' section index
Dim properties() as object
oSections = oDoc.getTextSections()
section = 0
Do While section < oSections.getCount()
oSection = oSections.getByIndex(section)
if (oSection.FileLink().FileURL() <> "") then
if oSection.supportsService("com.sun.star.text.TextSection") then
msgBox("Section " + section + ", called " + oSection.Name()
+ ", is a file link and supports TextSection"
URL = oSection.FileLink().FileURL()
oDoc.getText().removeTextContent( oSection )
oDoc.getText().createTextCursor().insertDocumentFromURL(URL, properties)
else
section = section + 1
end if
else
section = section + 1
end if
Loop
End Sub
|
Most of the contents of the "URL" file get inserted, but it looks like some images may be missing, and the order of sections is incorrect. Any assistance greatly appreciated 
kam
Last edited by kam on Thu Sep 08, 2005 1:17 am; edited 1 time in total |
|
| Back to top |
|
 |
kam
General User
Joined: 25 Aug 2005
Posts: 6
|
| Posted: Thu Aug 25, 2005 6:08 pm Post subject: getting there |
|
|
Ok, so I have the text behaving itself now - I changed the lines:
| Code: |
oDoc.getText().removeTextContent( oSection )
oDoc.getText().createTextCursor().insertDocumentFromURL(URL, properties)
|
to:
| Code: |
oAnchor = oSection.getAnchor()
oDoc.getText().removeTextContent( oSection )
oDoc.getText().createTextCursorByRange(oAnchor).insertDocumentFromURL(URL, properties)
|
The problem is now that images in the inserted document don't get copied into my document. I think there may be some other snippets for similar things, but please post if you can help.
Thanks,
kam |
|
| Back to top |
|
|
pitonyak
Administrator
Joined: 09 Mar 2004
Posts: 3618
Location: Columbus, Ohio, USA
|
| Posted: Fri Aug 26, 2005 6:13 am Post subject: |
|
|
download my free macro document and check out section 5.10.1 through 5.10.4. This may help, maybe not.
_________________
--
Andrew Pitonyak
http://www.pitonyak.org/oo.php |
|
| Back to top |
|
|
kam
General User
Joined: 25 Aug 2005
Posts: 6
|
| Posted: Tue Sep 06, 2005 4:56 pm Post subject: Problem Solved: removing text sections from master documents |
|
|
Much thanks to the authors of the resources found here, and of course, google, I have modified Danny's DocConverter so it can now handle master documents, automatically replacing linked sections with the contents of the files they link to.
I've tested this on the 66+ master documents I needed to convert, and it works. The issues I ran into are:
insertDocumentFromURL doesn't load images into the document.
If you have a section that begins with a TextTable, you get an extra paragraph before the table when you select the section and insertDocumentFromURL.
I'm not particularly happy with the workarounds, but in the interests of community sharing, here are the code snippets.
Firstly, I modifed the DocConverter GUI to include SXG as a file type in Step 3.
Second, I inserted a call to my new subroutine, removeSections(oDoc as Object), in the BeginConversion subroutine:
| Code: |
cDestURL = ConvertToUrl( cDestFolder + "/" + cDestName )
REM Added by kam
' Now we need to remove the sections, if it's a master document.
if (LCase(cSourceType) = "sxg" ) then
removeSections(oDoc)
end if
REM End of code added by kam
' Update some stuff on the screen to keep the user entertained.
oFld3.setText( "Saving..." )
|
The subroutine removeSections uses a helper to sort out the image problem. Although this works, it is not bullet-proof, since I don't have any way of reliably recognising that the images (with no actual image attached) in the main document match the ones in the section document. So I check the Position and the Size.
If the section I read in begins with a TextTable, I use the original document cursor (where I read the section file in) to enumerate over the text section, and delete the first element if it's not a TextTable (it's probably easier to understand the code than that statement).
Anyway, here's removeSections and its helper:
| Code: |
Sub removeSections(oDoc as Object)
REM Author: kam
Dim oSections as Object 'Enumerator used to enumerate the text sections
Dim oSection as Object 'The enumerated text section
Dim nSection as Long ' counter for sections
Dim oAnchor as Object ' section anchor in main document
Dim oDocCursor as Object ' cursor over the section anchor
Dim aProperties() as Object ' property list
oSections = oDoc.getTextSections()
nSection = 0
Do While nSection < oSections.getCount()
oSection = oSections.getByIndex(nSection)
if (oSection.FileLink().FileURL() <> "") then
if oSection.supportsService("com.sun.star.text.TextSection") then
URL = oSection.FileLink().FileURL()
sectionDoc = StarDesktop.loadComponentFromURL(URL, "_blank", 0,_
oImportOptions )
oAnchor = oSection.getAnchor()
oDoc.getText().removeTextContent( oSection ) ' so don't increment nSection!
oDocCursor = oDoc.getText.createTextCursorByRange(oAnchor)
oDocCursor.insertDocumentFromURL(URL, aProperties)
' check to see if there is a table at the start of the section... it means trouble with cursors
' this is a work around for a probable bug - when you read in a file that starts with a table, you get
' an extra paragraph at the start of the section.
oSectionEnum = sectionDoc.getText().createEnumeration()
if oSectionEnum.hasMoreElements() then
if oSectionEnum.nextElement().supportsService("com.sun.star.text.TextTable") then
'msgBox "section starts with a table!"
oDocEnum = oDocCursor.getText().createEnumeration()
if (oDocEnum.hasMoreElements()) then
oNextElem = oDocEnum.nextElement()
if not oNextElem.supportsService("com.sun.star.text.TextTable") then
' don't want this!
oNextElem.dispose()
end if
end if
end if
end if
' check to see if there are embedded images
if sectionDoc.Drawpage.getCount() <> 0 then
InsertGraphicObjectShapes(oDoc, sectionDoc)
end if
' if the section starts with a table, it doesn't get inserted properly (there's
' a line left over. While this is probably a bug, we should work around it.
sectionDoc.close(false)
else
msgBox "Found a section that doesn't support text"
nSection = nSection + 1
end if
else
nSection = nSection + 1
end if
Loop
End Sub
Sub InsertGraphicObjectShapes(oDoc as Object, oSectionDoc as Object)
REM Author: kam
Dim i as Integer
Dim j as Integer
Dim oDocGraph as Object
Dim oSectionPart as Object
For i = 0 To oSectionDoc.Drawpage.getCount() - 1
oSectionPart = oSectionDoc.Drawpage.getByIndex(i)
if oSectionPart.supportsService("com.sun.star.drawing.GraphicObjectShape") then
' check the sizes and find the matching one in the new document. This is a hack, but I don't know
' why I can't remove the images properly.
j = 0
do while j < oDoc.Drawpage.getCount()
oDocGraph = oDoc.Drawpage.getByIndex(j)
if oDocGraph.supportsService("com.sun.star.drawing.GraphicObjectShape") then
if oDocGraph.Size.Width = oSectionPart.Size.Width and oDocGraph.Size.Height = oSectionPart.Size.Height then
' msgBox "sizes match"
if oDocGraph.Position.x = oSectionPart.Position.x and oDocGraph.Position.y = oSectionPart.Position.y then
' msgBox "positions match"
oDocGraph.GraphicObjectFillBitmap = oSectionPart.GraphicObjectFillBitmap
end if
end if
end if
j = j + 1
loop
end if
Next i
end sub
|
I'm happy to give make the modifed macro file available to the original author, if interested.
Thanks,
kam
Last edited by kam on Thu Sep 08, 2005 1:18 am; edited 1 time in total |
|
| Back to top |
|
|
pitonyak
Administrator
Joined: 09 Mar 2004
Posts: 3618
Location: Columbus, Ohio, USA
|
| Posted: Wed Sep 07, 2005 5:56 am Post subject: |
|
|
This is a wonderful bit of code. Have you tried using copy and paste to copy the text? If so, does it copy images and tables correctly? I consider your method to be a better solution, I am just curious about copy and paste...
_________________
--
Andrew Pitonyak
http://www.pitonyak.org/oo.php |
|
| Back to top |
|
|
kam
General User
Joined: 25 Aug 2005
Posts: 6
|
| Posted: Wed Sep 07, 2005 4:24 pm Post subject: |
|
|
Hi Andrew,
Copy and paste didn't work - some of the documents have multiple frames, and I couldn't select them all programmatically. It probably can be done, but ran out of patience.
When you look at it, most of the code I've written is actually workarounds for issues with insertDocumentFromURL. Two problems have appeared in addition to the ones noted in my earlier message:
The extra paragraph only gets inserted if the first section begins with a table (subsequent ones are ok); and
insertDocumentFromURL overwrites the "com.sun.star.text.FieldMaster.User.*" text fields - so I now cache them and reload after I'm finished inserting the section.
By the way, these macros were developed using NeoOfficeJ on a Mac (version equivalent to OpenOffice 1.1.4), but since they are "core" OOo, I'm fairly confident that they will work on Open Office / StarOffice, etc.
-kam
The hopefully final version of the code I've added is:
| Code: |
Sub removeSections(oDoc as Object)
REM Author: kam
Dim oSections as Object 'Enumerator used to enumerate the text sections
Dim oSection as Object 'The enumerated text section
Dim nSection as Long ' counter for sections
Dim oAnchor as Object ' section anchor in main document
Dim oDocCursor as Object ' cursor over the section anchor
Dim aProperties() as Object ' property list
Dim bFirstSection as Boolean ' is this the first section we've read?
Dim aFields
aFields = Array() ' empty array to start with
'insertDocumentFromURL overrides user text fields; cache them now so we can restore them later.
sCacheFields(oDoc, aFields)
oSections = oDoc.getTextSections()
nSection = 0
bFirstSection = true
Do While nSection < oSections.getCount()
oSection = oSections.getByIndex(nSection)
if (oSection.FileLink().FileURL() <> "") then
if oSection.supportsService("com.sun.star.text.TextSection") then
URL = oSection.FileLink().FileURL()
sectionDoc = StarDesktop.loadComponentFromURL(URL, "_blank", 0,_
oImportOptions )
oAnchor = oSection.getAnchor()
oDoc.getText().removeTextContent( oSection ) ' so don't increment nSection!
oDocCursor = oDoc.getText.createTextCursorByRange(oAnchor)
' this will sometimes overwrite the text fields!
oDocCursor.insertDocumentFromURL(URL, aProperties)
' check to see if there is a table at the start of the section... it means trouble with cursors
' this is a work around for a probable bug - when you read in a file that starts with a table, you get
' an extra paragraph at the start of the section if it is the first section.
oSectionEnum = sectionDoc.getText().createEnumeration()
if oSectionEnum.hasMoreElements() then
if oSectionEnum.nextElement().supportsService("com.sun.star.text.TextTable") then
oDocEnum = oDocCursor.getText().createEnumeration()
if (oDocEnum.hasMoreElements()) then
oNextElem = oDocEnum.nextElement()
if not oNextElem.supportsService("com.sun.star.text.TextTable") then
' don't want this!
if bFirstSection then
oNextElem.dispose()
end if
end if
end if
end if
end if
' check to see if there are embedded images
if sectionDoc.Drawpage.getCount() <> 0 then
InsertGraphicObjectShapes(oDoc, sectionDoc)
end if
sectionDoc.close(false)
else
msgBox "Found a section that doesn't support text"
nSection = nSection + 1
end if
bFirstSection = false
else
nSection = nSection + 1
end if
Loop
sRepairFields(oDoc, aFields)
End Sub
' Replace the blank images inserted into oDoc by insertDocumentFromURL with the actual
' bitmaps taken from oSectionDoc.
Sub InsertGraphicObjectShapes(oDoc as Object, oSectionDoc as Object)
REM Author: kam
Dim i as Integer
Dim j as Integer
Dim oDocGraph as Object
Dim oSectionPart as Object
For i = 0 To oSectionDoc.Drawpage.getCount() - 1
oSectionPart = oSectionDoc.Drawpage.getByIndex(i)
if oSectionPart.supportsService("com.sun.star.drawing.GraphicObjectShape") then
' check the sizes and find the matching one in the new document. This is a hack!
j = 0
do while j < oDoc.Drawpage.getCount()
oDocGraph = oDoc.Drawpage.getByIndex(j)
if oDocGraph.supportsService("com.sun.star.drawing.GraphicObjectShape") then
if oDocGraph.Size.Width = oSectionPart.Size.Width and oDocGraph.Size.Height = oSectionPart.Size.Height then
' msgBox "sizes match"
if oDocGraph.Position.x = oSectionPart.Position.x and oDocGraph.Position.y = oSectionPart.Position.y then
' msgBox "positions match"
oDocGraph.GraphicObjectFillBitmap = oSectionPart.GraphicObjectFillBitmap
end if
end if
end if
j = j + 1
loop
end if
Next i
end sub
' Cache the ...FieldMaster.User fields to safeguard against overwriting via
' insertDocumentFromURL. The array aFields is modified.
sub sCacheFields(vDoc as Object, aFields)
REM Author: kam
REM Based on code from Danny's Basic Library
Dim vInfo, vVal, vNames
Dim i%, sKey$, sVal$, s$
Dim vTextFieldMaster
Dim sUserType$
sUserType = "com.sun.star.text.FieldMaster.User"
vVal = vDoc.getTextFieldMasters()
vNames = vVal.getElementNames()
' s = "===Text Field Masters==="
For i = LBound(vNames) to UBound(vNames)
sKey = vNames(i)
if Instr(sKey, "User") <> 0 then
' s = s & Chr$(13) & "(" & sKey
vTextFieldMaster = vVal.getByName(sKey)
If Not IsNull(vTextFieldMaster) Then
' s = s & "," & vTextFieldMaster.Name
'I have not verified that this is the case!
If (Left$(sKey,Len(sUserType)) = sUserType) Then
'User types also have a Value (double) and you can ask if they are
'expressions!
'http://api.openoffice.org/docs/common/ref/com/sun/star/text/FieldMaster/User.html
nNumProperties = NumPropertyValues( aFields )
If nNumProperties = 0 Then
aFields = Array( MakePropertyValue( sKey, vTextFieldMaster.Content ) )
Else
Redim Preserve aFields(nNumProperties)
aFields(nNumProperties) = MakePropertyValue( sKey, vTextFieldMaster.Content )
end if
' s = s & "," & vTextFieldMaster.Content
End If
End If
' s = s & ")"
end if
Next i
' MsgBox s, 0, "Text Field Masters"
End sub
' Replace the FieldMaster.User fields in vDoc by the cached values in aFields.
' vDoc is modified; aFields is not.
Sub sRepairFields(vDoc as Object, aFields)
REM Author: kam
REM Based on code from Danny's Basic Library
Dim vInfo, vVal, vNames
Dim i%, sKey$, sVal$, s$
Dim vTextFieldMaster
Dim sUserType$
sUserType = "com.sun.star.text.FieldMaster.User"
vVal = vDoc.getTextFieldMasters()
vNames = vVal.getElementNames()
' s = "===Text Field Masters==="
For i = LBound(vNames) to UBound(vNames)
sKey = vNames(i)
if Instr(sKey, "User") <> 0 then
' s = s & Chr$(13) & "(" & sKey
vTextFieldMaster = vVal.getByName(sKey)
If Not IsNull(vTextFieldMaster) Then
' s = s & "," & vTextFieldMaster.Name
If (Left$(sKey,Len(sUserType)) = sUserType) Then
for j = LBound(aFields) to UBound(aFields)
if sKey = aFields(j).Name then
vTextFieldMaster.Content = aFields(j).Value
end if
next j
' s = s & "," & vTextFieldMaster.Content
End If
End If
' s = s & ")"
end if
Next i
' MsgBox s, 0, "Text Field Masters"
end sub
|
|
|
| Back to top |
|
|
|
|
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum
|
Powered by phpBB © 2001, 2005 phpBB Group
|
