Openoffice與Lotus Notes整合 表格欄寬調整技巧

//***********************************************************
此斷程式碼使用來調整表格的欄寬，而OpenOffice調整欄寬的方式
與MS Word調整方式不一樣；OpenOffice的基準點是以表格欄與欄之間
分隔線所在的定位點往前或往後加減來調整欄寬。
假設：第一欄[oTblColSepsM( 0 ).Position =6000]位置所在為6000那要將欄調寬，
則是由原來的位置6000+1000 那欄寬就會加寬1000各單位
變成[oTblColSepsM( 0 ).Position =7000]，第二欄由此類推。
//***********************************************************


Sub Click(Source As Button)
Dim objServiceManager As Variant
Dim objCoreReflection As Variant
Dim objDesktop As Variant
Dim objDocument As Variant
Dim objTable As Variant
Dim objCursor As Variant
Dim op As Variant
Dim objDispatch As Variant
Dim objRows As Variant
Dim objRow As Variant
Dim objCellCursor As Variant
Dim objCellText As Variant
Dim PageStyles As Variant
Dim StdPage As Variant
Dim sURL As String
Dim session As New NotesSession
Dim db As NotesDatabase
 
Dim args() As Variant
Dim argsEnd() As Variant
'The service manager is always the starting point
'If there is no office running then an office is started up

' Initialize the OpenOffice Environment
Set objServiceManager = CreateObject("com.sun.star.ServiceManager")
 
 Set objDesktop = objServiceManager.createInstance("com.sun.star.frame.Desktop")

' Initialize the Lotus Notes Environment
Set db = session.CurrentDatabase
' URL to create a new file

sUrl ="private:factory/swriter"
Set objDocument = objDesktop.loadComponentFromURL(sURL, "_blank", 0, args)

Set objDispatch = objServiceManager.createInstance("com.sun.star.frame.DispatchHelper")

Set PageStyles=objDocument.StyleFamilies.getByName("PageStyles")

Set objText= objDocument.getText()
Set objCursor= objText.createTextCursor()
' objCursor.gotoStart(False)
Set StdPage= PageStyles.getByName(objCursor.PageStyleName)
StdPage.IsLandscape=True
StdPage.Width=29700
StdPage.Height=21000
objCursor.CharFontName="Courier"
objCursor.CharHeight=10
objCursor.CharWeight=100
objCursor.CharHeight=10

Set objMTable= objDocument.createInstance( "com.sun.star.text.TextTable")


objMTable.initialize 1, 3
'Insert the table
objText.insertTextContent objCursor, objMTable, False
'Get first row
Set objRows= objMTable.getRows()
Set objRow= objRows.getByIndex(0)

Set objCellText= objMTable.getCellByName("A1")
Set objCellCursor= objCellText.createTextCursor()
' objCellCursor.setPropertyValue "CharColor",16777225
' objCellCursor.setPropertyValue "CharWeight", 75
objCellText.insertString objCellCursor, "第一欄",False


'-----------------------------------------
' Dim objCell As Variant
' Dim objCellCursorA As Variant
' Set objCell = objTable.getCellByName("A1")
' Set objCellCursorA = objTable.createCursorByCellName("A1")
objCellCursor.ParaAdjust = 2

'7.5 Setting Text Attributes
'http://api.openoffice.org/docs/common/ref/com/sun/star/awt/FontWeight.html#BOLD
' objCellCursor = objCellText.createTextCursorByRange()
' Dim objReformat
Set objReformat= objMTable.getCellRangeByName("A1:A1")
' Set objReformat= objTable.getCellByName("A1")
' objCellCursor.CharWeight =75
objReformat.CharWeightAsian=100
'-----------------------------------------------------

Dim oTblColSepsM As Variant
objMTable.LeftMargin = 100
objMTable.RightMargin = 100
Dim iWidth As Variant
iWidth=objMTable.Width
' Msgbox "iWidth: " & iWidth '115591 /11=9826.976
Dim objTableSum As Variant
objTableSum=objMTable.TableColumnRelativeSum
' Msgbox "objTableSum:="& objTableSum '10000
Dim dRatio As Double
dRatio=objTableSum/iWidth
' Msgbox "Ratio:"& dRatio '8.65111...
Dim dRelativeWidth As Double
dRelativeWidth=(1000*dRatio)/2 '約0.11公分
' Msgbox "dRelativeWidth:"&dRelativeWidth '173.02 約等於0.44公分
Dim dPosition As Double
dPosition=objTableSum-dRelativeWidth
' Msgbox "dPosition:&"& dPosition '9826.976
' Msgbox objTableSum '10000
'由此開始調整欄寬
oTblColSepsM = objMTable.TableColumnSeparators
oTblColSepsM( 0 ).Position =6000+1000
oTblColSepsM( 1 ).Position =7000+2000
objMTable.TableColumnSeparators = oTblColSepsM

'插入分頁
' objText.insertControlCharacter objCursor, 0 , False
' objCursor.BreakType=4 '//PAGE_BEFORE
objCursor.BreakType=5 '//PAGE_AFTER
objText.insertControlCharacter objCursor, 0 , False

End Sub