OpenOffice.org Forum at OOoForum.orgThe OpenOffice.org Forum
 
 [Home]   [FAQ]   [Search]   [Memberlist]   [Usergroups]   [Register
 [Profile]   [Log in to check your private messages]   [Log in

Macros on servers

 
Post new topic   Reply to topic    OOoForum.org Forum Index -> OpenOffice.org Macros and API
View previous topic :: View next topic  
Author Message
kryptos66
General User
General User


Joined: 31 Oct 2007
Posts: 20

PostPosted: Sun Sep 14, 2008 1:28 am    Post subject: Macros on servers Reply with quote

Code:

Set objServiceManager= WScript.CreateObject("com.sun.star.ServiceManager")
Set objDesktop= objServiceManager.createInstance("com.sun.star.frame.Desktop")
Dim args()
Set objDocument= objDesktop.loadComponentFromURL("File:///C:\Documents%20and%20Settings\Cbr\Skrivebord\FourMonthTemplate.ott", "_blank", 0, args)

The above vbs code works fine for me on my home computer, but not at work on our networked computers, which is where I actually want to deploy this macro. I thought it might be a problem about spaces in path and file names, but
Code:

loadComponentFromURL("File:///L:\Syd\Common\Templates\FourMonthTemplate.ott", "_blank", 0, args)

which is where shared templates are stored doesn't work either. I've tried both forward leaning and backward leaning slashes. Generally speaking Open Office macros and templates on common drives seem to be riddled with deployment and execution problems, with all sorts of bizarre error messages popping up, and frustrating people, so they usually quickly give up, and go back to laborious plodding methods, building documents from scratch, using the commands from the menu and toolbars, or even abandon the computer altogether and compose their charts, forms and lists with pencil and paper! My workplace is not an IT company, my colleagues are not native English speakers, so the documentation they have access to is limited and in any case they have no ambition of becoming geeks, they just want something which works and saves time for them.
I'm not a geek either, but I am English and I do have an interest in IT so if I put my mind to it I can understand and use some of the available documentation when I can find it. Open Office is becoming quite a thief of my time, but I would consider it worthwhile if I finally could produce things, which could be of general interest and value to my colleagues.
Templates and macros stored on private drives seem to be less problematic, but I'm not about to help 80 colleagues individually set up a dozen macros in their private Open Office profile, and they are not going to respond to a mail with a more than four point instruction course in how to get hold of the macro I have produced and integrate it as a part of their private profile. So what I need is an icon they can just click on and be at least 90 % sure of getting a result.
Therefore I'm using vbs and;
Code:

Set objServiceManager= WScript.CreateObject("com.sun.star.ServiceManager")
Set objDesktop= objServiceManager.createInstance("com.sun.star.frame.Desktop")
Dim args()
Set objDocument= objDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, args)

..seems to get a stable result every time. That's not very exciting in itself and I'm in the process of building on it. For example I don't need my FourMonth Template any more. The following standalone vbs file will reliably produce, in 7 seconds (Open Office IS that slow on our server) a simple table with an calendar-type overview on the present and following three months, with two cells allocated to each day, and Sundays coloured in a ghastly pale violet. A simple enough thing, but something used widely in various contexts, and something inexperienced IT users can spend hours on if they have to start from scratch every time they need something like this. And it's self sufficient, no need for tearing hair out over libraries and modules and God knows what.
Having said that, it's far from perfect. To make it more adaptable to varying needs I need more knowledge on finessing. e.g. altering weight, colours of table borders, formatting text within cells, fonts, justification introducing and placing graphics etc. Other posts in these forums indicate that horizontal justification is a property missing in text table cells, but the operation is possible by getting hold of the paragraph properties of the text within the cell and adjusting that. I'd be very grateful if anyone knows how to do that within the context of my vbs code.

Code:

Set objServiceManager= WScript.CreateObject("com.sun.star.ServiceManager")
Set objDesktop= objServiceManager.createInstance("com.sun.star.frame.Desktop")
Dim args()
Set objDocument= objDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, args)

Set oViewCursor = objDocument.CurrentController.getViewCursor()
oPageStyleName = oViewCursor.PageStyleName
Set oPageStyles = objDocument.StyleFamilies.getByName("PageStyles")
Set oStyle = oPageStyles.getByName(oPageStyleName)

oStyle.LeftMargin = 450
oStyle.TopMargin = 470
oStyle.RightMargin = 450
oStyle.BottomMargin = 500

Set objText= objDocument.getText
Set objCursor= objText.createTextCursor

objText.insertControlCharacter objCursor, 0 , false
objText.insertControlCharacter objCursor, 0 , false

Set oTable= objDocument.createInstance( "com.sun.star.text.TextTable")
oTable.initialize 32, 9

objText.insertTextContent objCursor, oTable, false

Set objRows = oTable.GetRows
Set firstrow = objRows.GetbyIndex(0)
For T = 0 to 31
Set objrow  = objRows.GetbyIndex(T)
objrow.isautoheight=false
objrow.height=820
Next

firstrow.setPropertyValue "BackTransparent", true
firstrow.setPropertyValue "BackColor", 10040166

objcols= oTable.TableColumnSeparators
objcols(0).Position = 500
objcols(1).Position = 2325
objcols(2).Position = 2875
objcols(3).Position = 4700
objcols(4).Position = 5250
objcols(5).Position = 7075
objcols(6).Position = 7625
objcols(7).Position = 9450
oTable.TableColumnSeparators = objcols

For I = 1 To 31
    insertintocello "A"&I+1,I
Next

dennmon = Month(now)
If dennmon + 1 > 12 then
dennmon1 = dennmon - 11
else
dennmon1 = dennmon+1
end if
If dennmon + 2 > 12 then
dennmon2 = dennmon - 10
else
dennmon2 = dennmon+2
end if
If dennmon + 3 > 12 then
dennmon3 = dennmon - 9
else
dennmon3 = dennmon+3
end if

MyDate = DateSerial(year(now), dennmon, 1)
MyWeekDay = Weekday(MyDate)

Firstsun1mon = 10-MyWeekDay

ColorCell "B" & Firstsun1mon,15132415
ColorCell "C" & Firstsun1mon,15132415
ColorCell "B" & Firstsun1mon+7,15132415
ColorCell "C" & Firstsun1mon+7,15132415
ColorCell "B" & Firstsun1mon+14,15132415
ColorCell "C" & Firstsun1mon+14,15132415
ColorCell "B" & Firstsun1mon+21,15132415
ColorCell "C" & Firstsun1mon+21,15132415

If(Firstsun1mon+28 < 32) then
ColorCell "B" & Firstsun1mon+28,15132415
ColorCell "C" & Firstsun1mon+28,15132415
end if

My2Date = DateSerial(year(now), dennmon1, 1)
My2WeekDay = Weekday(My2Date)

Firstsun2mon = 10-My2WeekDay

ColorCell "D" & Firstsun2mon,15132415
ColorCell "E" & Firstsun2mon,15132415
ColorCell "D" & Firstsun2mon+7,15132415
ColorCell "E" & Firstsun2mon+7,15132415
ColorCell "D" & Firstsun2mon+14,15132415
ColorCell "E" & Firstsun2mon+14,15132415
ColorCell "D" & Firstsun2mon+21,15132415
ColorCell "E" & Firstsun2mon+21,15132415

If(Firstsun2mon+28 < 32) then
ColorCell "D" & Firstsun2mon+28,15132415
ColorCell "E" & Firstsun2mon+28,15132415
end if

My3Date = DateSerial(year(now), dennmon2, 1)
My3WeekDay = Weekday(My3Date)

Firstsun3mon = 10-My3WeekDay

ColorCell "F" & Firstsun3mon,15132415
ColorCell "G" & Firstsun3mon,15132415
ColorCell "F" & Firstsun3mon+7,15132415
ColorCell "G" & Firstsun3mon+7,15132415
ColorCell "F" & Firstsun3mon+14,15132415
ColorCell "G" & Firstsun3mon+14,15132415
ColorCell "F" & Firstsun3mon+21,15132415
ColorCell "G" & Firstsun3mon+21,15132415

If(Firstsun3mon+28 < 32) then
ColorCell "F" & Firstsun3mon+28,15132415
ColorCell "G" & Firstsun3mon+28,15132415
end if

My4Date = DateSerial(year(now), dennmon3, 1)
My4WeekDay = Weekday(My4Date)

Firstsun4mon = 10-My4WeekDay

ColorCell "H" & Firstsun4mon,15132415
ColorCell "I" & Firstsun4mon,15132415
ColorCell "H" & Firstsun4mon+7,15132415
ColorCell "I" & Firstsun4mon+7,15132415
ColorCell "H" & Firstsun4mon+14,15132415
ColorCell "I" & Firstsun4mon+14,15132415
ColorCell "H" & Firstsun4mon+21,15132415
ColorCell "I" & Firstsun4mon+21,15132415

If(Firstsun4mon+28 < 32) then
ColorCell "H" & Firstsun4mon+28,15132415
ColorCell "I" & Firstsun4mon+28,15132415
end if

insertIntoCell "B1",Monthname(dennmon,false)
insertIntoCell "D1",Monthname(dennmon1,false)
insertIntoCell "F1",Monthname(dennmon2,false)
insertIntoCell "H1",Monthname(dennmon3,false)

Sub insertIntoCell( strCellName, strText)
   Set objCellText= oTable.getCellByName( strCellName)
   Set objCellCursor= objCellText.createTextCursor
   objCellCursor.setPropertyValue "CharColor",16765728
   objCellText.insertString objCellCursor, strText, false
End Sub

Sub ColorCell(cellref,kolo)
   Set objcell= oTable.getCellByName(cellref)   
   objcell.setPropertyValue "BackTransparent", false
   objcell.setPropertyValue "BackColor", kolo
End Sub

Sub insertIntoCello( strCellName, strText)
   Set objCellTexto= oTable.getCellByName( strCellName)
   Set objCellCursoro= objCellTexto.createTextCursor
   objCellTexto.insertString objCellCursoro, strText, false
   objCellTexto.VertOrient=2
End Sub

oViewCursor.gotoStart(false)
[/code]
Back to top
View user's profile Send private message
Display posts from previous:   
Post new topic   Reply to topic    OOoForum.org Forum Index -> OpenOffice.org Macros and API All times are GMT - 8 Hours
Page 1 of 1

 
Jump to:  
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