試用 Array() 做變數：分頁名稱

 
 
Sub Main_11

    DIm oArray(3) As String
        oArray(0)="Sheet1"
        oArray(1)="Sheet2"
        oArray(2)="Sheet3"

        oDoc=ThisComponent
        oController=oDoc.getCurrentController()
        oSheets=oDoc.getSheets()

        for i=0 to 2 step 1
            oController.setActiveSheet(oSheets.getByName(oArray(i)))
        next i

End sub

以 range 概念取得最後行數

Sub Main_13
    Dim oRange As Object , oCursor As Object
    oRange = ThisComponent.Sheets(2).getCellRangeByName("C1")
    oCursor = ThisComponent.Sheets(2).createCursorByRange(oRange)
        '
        '以 collapseToCurrentRegion  範圍來取得
        oCursor.collapseToCurrentRegion
        Msgbox oCursor.getRows.Count
        Msgbox oCursor.getColumns.Count
        '
        '以 gotoEndOfUsedArea  範圍來取得 
        oCursor.gotoEndOfUsedArea(true)
        Msgbox oCursor.getRows.Count
        Msgbox oCursor.getColumns.Count
end sub

另一個取代 Range ("A65536").End (xlUp).Row 方法

REM  *****  BASIC  *****

Sub Main
  '指定要取得 "Sheet1" B 欄 的最後欄位
  'Ooo 由零開始，我習慣 +1
  LastRow=GetLastRow("Sheet1","B") +1
  msgbox LastRow
End Sub

Function GetLastRow(SHT as string , COL as string)as integer
  With ThisComponent
    oController = .getCurrentController()
    oSheets = .getSheets()
    '讀取傳入的「分頁名稱」變數 SHT
    oSheet1 = oSheets.getByName( SHT )
    oController.setActiveSheet( oSheet1 )
  End With

  '呼叫 UNO
  document   = ThisComponent.CurrentController.Frame
  dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

  rem ----------------------------------------------------------------------
  '讀取傳入的「欄位」變數 COL，再以 UNO 控制「游標」到最後一行 1048576
  dim args1(0) as new com.sun.star.beans.PropertyValue
  args1(0).Name = "ToPoint"
  args1(0).Value = COL & "1048576"
 
  dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args1())

  REM -------------------------------------------------------------------------------
  '以 UNO 控制「游標」由最後一行 1048576 跳至有資料的一行
  dim args4(1) as new com.sun.star.beans.PropertyValue
  args4(0).Name = "By"
  args4(0).Value = 1
  args4(1).Name = "Sel"
  args4(1).Value = false

  dispatcher.executeDispatch(document, ".uno:GoUpToStartOfData", "", 0, args4())
REM -------------------------------------------------------------------------------
  ' 同樣，取得該行的 ROW 數，傳回 GetLastRow 再交回主程式。
  GetLastRow=ThisComponent.CurrentController.getSelection().RangeAddress.StartRow
  'GetLastCol=ThisComponent.CurrentController.getSelection().RangeAddress.StartColumn
End Function

取代 Range ("A65536").End (xlUp).Row

Ooo 長期以來，一直未有取代 Range ("A65536").End (xlUp).Row 的簡單句式，
今數據收集的工作很困難。只好在 Ooo 混用了 VBA 語法。

這兩天偶然發現兩個方法。記下來。

-1- 利用輔助列及COUNTBLANK，計出另一欄的最後一列。

PysCell = thiscomponent.sheets.getByName("Sheet1").getCellRangeByName("C1")
PysCell.formula = "=65536-COUNTBLANK(B1:B65536)"
print PysCell.value


-2- 利用 Function GetLastRow ，直接讀出某一欄的最後一列。

Sub Main
    LastRow=GetLastRow(1,0)
end sub

Function GetLastRow(x as integer,i as integer)as integer
    oSheet = ThisComponent.getSheets().getByIndex(i)
    oTargetCell = oSheet.getCellByPosition(x, 0)

        If IsNull(oTargetCell) then
            GetLastRow =oTargetCell.getRangeAddress.EndRow
        Else
            oCursor = oSheet.createCursorByRange(oTargetCell)
            oCursor.gotoEnd
            GetLastRow = oCursor.getRangeAddress.EndRow + 1
        End if

End Function

OpenOffice.org Macros Explained (Third Edition)

Andrew Pitonyak 先生的 OpenOffice.org Macros Explained 一書，一直是 寫 OpenOffice Macros 的權威，與另一本 StarSuite 8 BASIC 程式設計指南 都是我案頭書。

最近瀏覽 Andrew Pitonyak 先生的網站時，發現  OpenOffice.org Macros Explained 已著手修改成第三版，並提供下載。



我當然不甘後人，又有書可看了。

OpenOffice 或許有版權問題出現

　
OpenOffice 或許有版權問題出現。

綜合消息指：

1- 美國大公司併購後，Oracle 取得 OpenOffice 的主要控制權，
又暗中將「完全免費」的 OpenOffice 「授權」收改，表明
Oracle 擁有 OpenOffice 的完全版權，又條改一些條款。當中
以 Windows 版本最受影響，日後公司使用時可能要付版權費。

2- 一向擁有 OpenOffice 的 OpenOffice.org 機構在 9 月 28 日突
然宣佈推出另一套以 OpenOffice 為藍本的新軟件。

3- 新軟件名稱為 LibreOffice ，網址： http://www.documentfoundation.org/

4- 相關的資料

http://www.computerworld.com/s/article/9188338/Update_OpenOffice.org_developers_move_to_break_ties_with_Oracle
http://linuxtoy.org/archives/openofficeorg-%E7%A4%BE%E5%8C%BA%E5%AE%A3%E5%B8%83%E5%BB%BA%E7%AB%8B-document-foundation.html
　
　
　

替代 Range ("A65536").End (xlUp).Row

REM ***** BASIC *****
' Source
' http://www.h3.dion.ne.jp/~sakatsu/OOo_vs_VBA.htm
' http://blog.livedoor.jp/addinbox/archives/51212979.html
' http://openoffice3.web.fc2.com/OOoBasic_General.html

Sub Main

Dim oSheet As Object
Dim oCell As Object

oSheet = ThisComponent.Sheets(0)

'oCell = GetLastCell(oSheet.Rows(1),True)
'oCell = GetLastCell(oSheet.getCellRangeByName("A2:AMJ2"),True)
'oCell = GetLastCell(oSheet.Columns(0),True)

oCell = GetLastCell(oSheet.getCellRangeByName("A1:A65536"),True)

'MsgBox oCell.AbsoluteName
MsgBox oCell.CellAddress.Row
MsgBox oCell.CellAddress.Column
End Sub

'=======[ GetLastCell ]==============
' [argRowCol]
' It appoints one Row range or one Column range.
' In the case of one Row range, it is searched the Right-End cell.
' In the case of one Column range, it is searched the Bottom cell.
' [argNextCell]
' In the case of True or omission, next cell (Empty Cell) of the last cell returns.
' In the case of False, the last cell returns.
' In the case of an empty cell all, the Top cell (or Left-End cell) returns.
' When the last cell is not Empty-Cell, Nothing returns in argNextCell=True,
' and the last cell returns in argNextCell=False.

Global Function GetLastCell(ByRef argRowCol As Object, _
Optional ByVal argNextCell As Boolean) As Object
Dim oRanges As Object
Dim oRowCol As Object
Dim oEmptyRanges As Object
Dim intEmptyRangesCount As Integer
Dim oLastRange As Object
Dim oCell As Object
Dim blnNextCell As Boolean
Dim blnGetRow As Boolean
Dim lngRow As Long
Dim lngCol As Long

If IsMissing(argNextCell) Then
blnNextCell = True
Else
blnNextCell = argNextCell
End If

Select Case argRowCol.ImplementationName
Case "ScCellObj"
GetLastCell = Nothing
Exit Function
Case "ScCellRangeObj", "ScTableColumnObj", "ScTableRowObj"
oRowCol = argRowCol
Case "ScCellRangesObj", "ScTableColumnsObj", "ScTableRowsObj"
oRanges = argRowCol
If (oRanges.Count = 1) Then
oRowCol = oRanges(0)
Select Case oRowCol.ImplementationName
Case "ScCellObj"
GetLastCell = Nothing
Exit Function
Case "ScCellRangeObj", "ScTableColumnObj", "ScTableRowObj"
'OK
Case "ScCellRangesObj", "ScTableColumnsObj", "ScTableRowsObj"
GetLastCell = Nothing
Exit Function
Case Else
GetLastCell = Nothing
Exit Function
End Select
Else
GetLastCell = Nothing
Exit Function
End If
Case Else
GetLastCell = Nothing
Exit Function
End Select

If (oRowCol.Rows.Count = 1) Then
blnGetRow = False '1 Row is [get Right_End_Cell]
ElseIf (oRowCol.Columns.Count = 1) Then
blnGetRow = True '1 column is [get Bottom_Cell]
Else
GetLastCell = Nothing
Exit Function
End If

'Last cell is Empty?
With oRowCol.RangeAddress
oCell = oRowCol.SpreadSheet.getCellByPosition(.EndColumn, .EndRow)
If (oCell.Type <> com.sun.star.table.CellContentType.EMPTY) Then
If blnNextCell Then
GetLastCell = Nothing
Else
GetLastCell = oCell
End If
Exit Function
End If
End With

oEmptyRanges = oRowCol.queryEmptyCells()
intEmptyRangesCount = oEmptyRanges.Count
If (intEmptyRangesCount = 0) then
GetLastCell = oRowCol.getCellByPosition(0,0)
Else
oLastRange = oEmptyRanges.getByIndex(intEmptyRangesCount -1)
oCell = oLastRange.getCellByPosition(0,0)
If blnNextCell Then
GetLastCell = oCell
Else
With oCell.CellAddress
If blnGetRow Then
lngCol = .Column
lngRow = .Row - 1
Else
lngCol = .Column - 1
lngRow = .Row
End If
End With
GetLastCell = oCell.SpreadSheet.getCellByPosition(lngCol, lngRow)
End If
End If
End Function

使用 CurrentRegion

　
option VBAsupport 1
　
Sub Main
　
　'將所需資料存入 陣列DataRange ，必須指定開始的位置
　DataRange = cells(4,1).CurrentRegion
　' 陣列DataRange 的行數
　DataRangeRowsCount = cells(4,1).CurrentRegion.Rows.Count
　' 陣列DataRange 的欄數
　DataRangeColsCount = cells(4,1).CurrentRegion.columns.Count

　　' 抄至 I10: 21
　　range(cells(10,9),cells(10+DataRangeRowsCount -1,9+DataRangeColsCount-1))=DataRange
　
End Sub
　
　

















　
　
　
　

Ooo 的 MacroExecutionMode

　　
因為保安理由，Ooo 用 Macro 開啟一個「含有 Macro 新檔案」時，「新檔案」的 Macro 不會執行。

為了這個問題，上網找了很多資料，始終是日本人的工作細緻，給了個解答。以下是主要的程式碼：

Sub bbb_open

Dim oDoc,oDoc1 As Object
Dim sUrl As String
Dim mArg(0) As New com.sun.star.beans.PropertyValue

oDoc=StarDesktop.CurrentComponent
sUrl="file:///C:/usr/bbb.ods"

mArg(0).Name = "MacroExecutionMode"
mArg(0).Value = com.sun.star.document.MacroExecMode.USE_CONFIG　'按 openoffice 設定
oDoc1 = StarDesktop.loadComponentFromURL(sUrl, "_blank", 0, mArg())

oDoc.close(true)

End Sub

順手記一下：

新檔案禁止執行 Macro： NEVER_EXECUTE
新檔案容許執行 Macro ： ALWAYS_EXECUTE_NO_WARN　　
　　
　　　
　

Ooo :先搜尋再寫入

　　
REM 工作上，我會收集同事做的檔案，再整合交給主管。
REM 同事負責的檔案資料各不相同，但有一「特定編號」。
REM 我的做法是，將所有同事的檔案按日 01-31 抄至不同分頁。
REM 然後按「特定編號」將每日資料抄回 main 頁，再匯出成 excel 檔案。
REM 以下是其中一份 code 。
　
REM ***** BASIC *****
　
option VBAsupport 1
　
sub Match01()
　　Dim oFuncService As Object
　　Dim oRange As Object
　　'Dim vntRC As Variant
　　Dim oSelection As Object
'************************ 在ActiveSheet 讀取 cell 內的值
　　　oActiveSheet=ThisComponent.CurrentController.ActiveSheet
　　　oCrits=oActiveSheet.getCellByPosition(1,5) ' 指定要讀取的儲存格
　　　myvalue = oCrits.getString() ' 讀出指定儲存格的值
　　　'print myvalue ' 顯示是否正確
'************************ 承上，以 Array 來讀取 ActiveSheet 一系列 cell 內的值
　　'oSelection = oDocument.CurrentController.Selection
　　DataRange = Range("B4").CurrentRegion '將所需資料存入 陣列DataRange ，必須指定開始的位置
　　DataRangeRowsCount = Range("B4").CurrentRegion.Rows.Count ' 陣列DataRange 的行數
　　DataRangeColsCount = Range("B4").CurrentRegion.columns.Count ' 陣列DataRange 的行數
　　mmm=DataRange(1,3) ' 由於使用了 vba array，故 DataRange(x,y)中的 x為列數，y為欄數
'************************ 跳回 main 頁，並進行搜尋，然後取出vntRC所在列數(未減 1 的列數)
　　oFuncService = CreateUnoService("com.sun.star.sheet.FunctionAccess") ' 呼叫 match 基本功能
　　oRange = ThisComponent.Sheets.getByName("Main").getCellRangeByName("A1:A47") '指定要搜尋的範圍
　　'vntRC = oFuncService.callFunction("MATCH", Array("中國人", oRange, 0) )
　　aArrayValue=DataRange(1,1) '將要搜尋的 index 轉換為變數
　　vntRC = oFuncService.callFunction("MATCH", Array(aArrayValue, oRange, 0) )'進行搜尋

　If IsEmpty(vntRC) Then
　　　　MsgBox "NotFound" '測試用語用
　Else
　　　　MsgBox vntRC '讀出所在列
　End If

　　'Sheets("Main").range("B" & vntRC -1 )=aArrayValue
　　'Sheets("Main").cells(vntRC , 4 )=aArrayValue '寫入變數
　　Sheets("Main").cells(vntRC , 4 )=DataRange(1,2) '寫入變數
　　Sheets("Main").cells(vntRC , 4+1 )=DataRange(1,3) '寫入變數
End sub
　　
　　
　　

REM ***** BASIC *****

option vbasupport 1

Sub Main

Dim cRange As new com.sun.star.table.CellRangeAddress

Set oWorkBook = ThisComponent
Set oActiveSheet = ThisComponent.CurrentController.ActiveSheet
'Sheet = thisComponent.Sheets("Sheet1")
'msgbox oWorkBook.title & " " & oActiveSheet.name

LastRowCount=range("c65536").end(xlup).row +1
'range("C" & vi)="hjflsfajfsl;ajf"

Cell = oActiveSheet.getCellRangeByName("B3")
Cell.String = "Totals"

'SumRange="B6:B" & LastRowCount
'XSumRange="range(" & SumRange & ")"
'宣告 oFunction

oFunction = CreateUnoService("com.sun.star.sheet.FunctionAccess")
'oFunction.NullDate = ThisComponent.NullDate
'oRange = oActiveSheet.getCellRangeByPosition(0,0,0,3) 'A1:A4
for i=1 to 20
oRange = oActiveSheet.getCellRangeByPosition(i,5,i,LastRowCount) 'B6:B12
oActiveSheet.getCellByPosition(i,3).value=oFunction.callFunction("SUM",Array(oRange))
next i
'
'lValue = oFunction.callFunction("SUM",Array(oRange))
'RANGE("b4")=lValue
'oActiveSheet.getCellRangeByPosition(1,6)=lValue
'oActiveSheet.getCellByPosition(1,4).value=lValue
' oSheet.getCellByPosition(0,5).setValue(lValue)
' oRange = oSheet.getCellRangeByPosition(1,0,1,3) 'B1:B4
' lValue = oFunction.callFunction("AVERAGE",Array(oRange))
' oSheet.getCellByPosition(1,5).setValue(lValue)
' oRange = oSheet.getCellRangeByName("C1:C4")
' lValue = oFunction.callFunction("MIN",Array(oRange))
' oSheet.getCellByPosition(2,5).setValue(lValue)
' oRange = oSheet.getCellRangeByName("D1:D4")
' lValue = oFunction.callFunction("MAX",Array(oRange))
'
'Cell = oActiveSheet.getCellRangeByName("B4")
'Cell.Fornula = "=SUM(B6:B31)"



End Sub

Ooo 與 vba 的兼容性

　
用 google 找了一個早上，沒甚麼文件提及 Ooo 兼容了 vba 的那些特性，
只好自已動手試。

以下的 vba 碼都成功用於 Ooo 上。
　
REM ***** BASIC *****

' 宣告與 vba 相容
Option VBASupport 1

Sub Main
　
Workbooks.Open Filename:="c:\Ooo\no1.ods" ', ReadOnly:=True
Workbooks.Open Filename:="c:\Ooo\no2.ods" ', ReadOnly:=True
　
'Workbooks("no1.ods").Workbookssheet
'print activesheet.name
set rng = Workbooks("no2.ods").Worksheets("Data").Range("A1:D10")
Workbooks("no1.ods").Worksheets("sheet2").Range("A1:D10").Value = rng.Value
　
Workbooks("no2.ods").Worksheets("Data").Range("e1")="Worksheets(Data)"
Workbooks("no1.ods").Worksheets("sheet2").Range("e1")="Worksheets(sheet2)"
　
End Sub
　
　
　

Ooo Basic 如何取得最後一行

　　
上網扒了一個晚上，原來可以用 vba 句法，簡單多了。明天再試其它功能。

Option VBASupport 1
　
Sub Main
　　r1 = Worksheets("Sheet1").Range("F65536").End(xlUp).Row
　　print r1
End Sub
　
　
　

(轉載) Ooo Basic 將 data 抄至另一 SpreadSheet (4)

　
算是成功了一半，接下來是：

如何檢查行數、列數？

如何在最後一行寫入新資料？


REM ***** BASIC *****
'
' 2010/03/09 13:12
' 功能：抄檔案
' 1- 一個任意名檔案，以儲存本程式。亦可提供一些變數設定。
' 2- oMainDoc 為主檔，接收固定檔案的資料。
' 本例的檔案是 C:\Ooo\no1.ods
' 檔案的入數分頁(sheet.name)是 Main
' 3- oDataDoc 為資料檔，向主檔 oMainDoc 提供資料。
' 本例的檔案是 C:\Ooo\no2.ods
' 檔案的資料分頁是 Data '
'
' 4- oMainDoc 資料檔 open 後，向指定位置的 oDataDoc copy 資料。

'
Sub mutiSpreadsheet02

Dim oMainDoc as Object
Dim oSheet as Object
Dim oCell as Object

REM ***** 處理 oDataDoc

oDataDoc="no2"
oDataDocExtension=".ods"
oDataDocPath="C:\Ooo\"

'oDataDoc = "C:\Ooo\no2.ods" ' Windows
oDataDoc = oDataDocPath & oDataDoc & oDataDocExtension
'sFile = "/home/danny/Desktop/MyCalc.sxc" ' Linux
sURL2 = ConvertToURL(oDataDoc)

' 檢查文件是否存在，如果不存在則通知
If fileExists (oDataDoc) Then
'oDataDoc = StarDesktop.loadComponentFromURL(sURL2, "_blank", 0, Array())
oDataDoc = StarDesktop.loadComponentFromURL(sURL2, "MyFrame", 0, Array())
Else
msgbox oDataDoc & " 不存在！"
exit sub
End If
'
REM ***** 處理 oMainDoc

sFile1Name="no1"
sFile1NameExtension=".ods"
sFile1Path="C:\Ooo\"

sFile1 = sFile1Path & sFile1Name & sFile1NameExtension
sURL1 = ConvertToURL(sFile1)

' 檢查文件是否存在，如果不存在則通知
If fileExists (sFile1) Then
'oMainDoc = StarDesktop.loadComponentFromURL(sURL2, "_blank", 0, Array())
oMainDoc = StarDesktop.loadComponentFromURL(sURL1, "MyFrame", 0, Array())
Else
msgbox sFile1 & " 不存在！"
exit sub
End If
'
REM ***** 開始抄寫資料


'oDataDoc
'oMainDoc

' 指定 oMainDoc 的 sheet 名稱

oMainDocSheetName="Main"
oMainDocSheet = oMainDoc.Sheets.getByName(oMainDocSheetName)

' 指定 DataDoc 的 sheet 名稱

oDataDocName="Data"
oDataDocSheet = oDataDoc.Sheets.getByName(oDataDocName)

'count through the rows of the import sheet to, 抄至 250 欄
For RowPosition = 0 to 249

'count through the columns that need to be copied, 只抄 13 行
For ColPosition = 0 to 12

' select cell to copy
'CellCopy = SheetCopy.getCellByPosition (RowPosition, ColPosition)
' copy cell contects as string to contents variable
'Contents = Cstr(Cell)

CellCopy = oDataDocSheet.getCellByPosition (RowPosition, ColPosition)
Contents = CellCopy.String

'select the cell to paste the copied info into
CellPaste = oMainDocSheet.getCellByPosition (RowPosition+2, ColPosition+5)

'paste the contents variable into the selected cell
CellPaste.String = Contents

'move to next column
Next ColPosition

'move to next row
Next RowPosition

msgbox "Finish !"

End Sub

　
　
　

(轉載) Ooo Basic 將 data 抄至另一 SpreadSheet (３)

　　
記下來...

　　
REM ***** BASIC *****
Sub mutiSpreadsheet
'
' 2010/03/06
' 抄檔案：oDoc2 為主檔， oDoc1 為資料檔
' oDoc2 本機主檔，位置固定。
' oDoc1 資料檔，在 sharefolder，名稱每日不同。
' oDoc1 資料檔 open 後，指定位置 copy ，返回 oDoc2 並 paste 。
'
Dim oDoc1 as Object
Dim oSheet as Object
Dim oCell as Object



' 處理 oDoc2
sFile2Name="no2"
sFile2NameExtension=".ods"
sFile2Path="C:\Ooo\"
'sFile2 = "C:\Ooo\no2.ods" ' Windows
sFile2 = sFile2Path & sFile2Name & sFile2NameExtension
'sFile = "/home/danny/Desktop/MyCalc.sxc" ' Linux
sURL2 = ConvertToURL(sFile2)
' 檢查文件是否存在，如果不存在則通知
If fileExists (sFile2) Then
'oDoc2 = StarDesktop.loadComponentFromURL(sURL2, "_blank", 0, Array())
oDoc2 = StarDesktop.loadComponentFromURL(sURL2, "MyFrame", 0, Array())
Else
msgbox sFile2 & " 不存在！"
exit sub
End If
'
' 處理 oDoc1
sFile1Name="no1"
sFile1NameExtension=".ods"
sFile1Path="C:\Ooo\"
sFile1 = sFile1Path & sFile1Name & sFile1NameExtension
sURL1 = ConvertToURL(sFile1)
' 檢查文件是否存在，如果不存在則通知
If fileExists (sFile1) Then
'oDoc1 = StarDesktop.loadComponentFromURL(sURL2, "_blank", 0, Array())
oDoc1 = StarDesktop.loadComponentFromURL(sURL1, "MyFrame", 0, Array())
Else
msgbox sFile1 & " 不存在！"
exit sub
End If
'
' 開始抄寫資料
' 1- 將焦點定在 oDoc1
oSheet = oDoc1.sheets(0)
' 2- 指定 oDoc1 的 sheet
oDoc1Sheet="sheet1"
oSheet = oDoc1.Sheets.getByName(oDoc1Sheet)
' 3- 指定位置寫入資料
' 注意，Ooo 是以 0 開始，故 (1,3) 等同 excel 的 (2,4) ，即 D2 位置
nCOL1=3
nROW1=1
oCell = oSheet.getCellByPosition (nROW1,nCOL1)
oCell.String = now 'This function returns the current date and time
oCell = oSheet.getCellByPosition (nROW1+2,nCOL1+1)
oCell.String ="快樂使用 Ooo "
mmm=oCell.value
REM ##### 將焦點放回第一個開啟的 man_test_oo1.ods
' 4- 將焦點定在 oDoc2，等同於以下的 VBA 用法
' VBA Workbooks(tFile).Worksheets("Main").Activate
' VBA Windows(ssht).Activate
oDoc2.CurrentController.Frame.ContainerWindow.toFront()
oDoc2.CurrentController.Frame.Activate()


oSheet = oDoc2.sheets (0)
oCell2 = oSheet.getCellByPosition (0,0)
oCell2.String = "我是中國人" 'This function returns the current date and time
oCell2 = oSheet.getCellByPosition (1,1)
oCell2.String = mmm



'oSourceRange=oDoc2.Sheets.getByName("Sheet1").getcellrangebyposition(3,22,3,27) '
'oTargetRange=oDoc1.Sheets.getByName("Sheet2").getcellrangebyposition(3,22,3,27)
'oTargetRange.setformulaarray(oSourceRange.getformulaarray())
'oDoc1.Sheets.getByName("Sheet2").getcellrangebyposition(3,22,3,27)=oSourceRange
'oDoc1.CopyRange(oCellCpy, oRangeOrg)
'oDoc1.CopyRange(oSourceRange, oTargetRange)




End Sub
　　　
　　
　　

(轉載) Ooo Basic 將 data 抄至另一 SpreadSheet (2)

　　
REM ***** BASIC *****
REM ***** Author: robingonzalez
REM ***** Date: 2010/02/18
REM ***** http://www.oooforum.org/forum/viewtopic.phtml?t=95876
REM ***** 同一檔案下，兩張 sheet 抄寫資料。因為逐個儲存格做，速度慢。
REM ***** 優點是容易閱讀，容易修改。
REM ***** 修正 2010/03/09
REM ***** 要修正原稿部份程式碼。
REM ***** 1- 計算
REM ***** 1- sheet 名以變數取代
REM ***** 2- count 要以變數取代 0-249, 0-12
REM ***** 3- 可在兩個 workbook 中互抄檔案
REM *****
　
Sub Main

Dim ColPosition as Integer
Dim RowPosition as Integer
Dim Doc as Object
Dim SheetCopy as Object
Dim SheetPaste as Object
Dim CellCopy as Object
Dim CellPaste as Object
Dim Contents as String

Doc = ThisComponent 'sets Doc as the current spreedsheet
SheetCopy = Doc.Sheets.getByName ("Import") 'Assigns the Import sheet as the sheet to copy from
SheetPaste = Doc.Sheets.getByName ("Paste") 'Assigns the Paste sheet as the sheet to paste to

For RowPosition = 0 to 249 'count through the rows of the import sheet to, 抄至 250 欄
For ColPosition = 0 to 12 'count through the columns that need to be copied, 只抄 13 行
'CellCopy = SheetCopy.getCellByPosition (RowPosition, ColPosition) ' select cell to copy
'Contents = Cstr(Cell) ' copy cell contects as string to contents variable
CellCopy = SheetCopy.getCellByPosition (RowPosition, ColPosition)
Contents = CellCopy.String

CellPaste = SheetPaste.getCellByPosition (RowPosition+2, ColPosition+5) 'select the cell to paste the copied info into
CellPaste.String = Contents 'paste the contents variable into the selected cell
Next ColPosition 'move to next column
Next RowPosition 'move to next row
msgbox "Finish !"
End Sub
　　
　　
　　

(轉載) Ooo Basic 將 data 抄至另一 SpreadSheet

　
努力中...

REM ***** BASIC *****

'Copy and paste a range using the clipboard.
'The first example sent to me selects cells in a spreadsheet and then pastes them into a different spreadsheet.
'Author: Ryan Nelson
'email: ryan@aurelius-mfg.com
'Modified By: Christian Junker and Andrew Pitonyak
'This macro copies a range and pastes it into a new or existing spreadsheet.
Sub CopyPasteRange()

Dim oSourceDoc, oSourceSheet, oSourceRange
Dim oTargetDoc, oTargetSheet, oTargetCell
Dim oDisp, octl
Dim sUrl As String
Dim NoArg()

REM Set source doc/currentController/frame/sheet/range.
oSourceDoc=ThisComponent
octl = oSourcedoc.getCurrentController()
oSourceframe = octl.getFrame()
oSourceSheet= oSourceDoc.Sheets(0)
oSourceRange = oSourceSheet.getCellRangeByPosition(0,0,100,10000)

REM create the DispatcherService
oDisp = createUnoService("com.sun.star.frame.DispatchHelper")

REM select source range
octl.Select(oSourceRange)

REM copy the current selection to the clipboard.
oDisp.executeDispatch(octl, ".uno:Copy", "", 0, NoArg())

REM open new spreadsheet.
sURL = "private:factory/scalc"
oTargetDoc = Stardesktop.loadComponentFromURL(sURL, "_blank", 0, NoArg())
oTargetSheet = oTargetDoc.getSheets.getByIndex(0)

REM You may want to clear the target range prior to pasting to it if it
REM contains data and formatting.
REM Move focus to cell 0,0.
REM This ensures the focus is on the "0,0" cell prior to pasting.
REM You could set this to any cell.
REM If you don't set the position, it will paste to the
REM position that was last in focus when the sheet was last open.
oTargetCell = oTargetSheet.getCellByPosition(0,0)
oTargetDoc.getCurrentController().Select(oTargetCell)

REM paste from the clipboard to your current location.
oTargetframe = oTargetDoc.getCurrentController().getFrame()
oDisp.executeDispatch(oTargetFrame, ".uno:Paste", "", 0, NoArg())

End Sub
　
　
　

Ooo Basic 的 X-Ray_tool

　
Ooo Basic 的 IDE 夠簡陋了， X-Ray_tool 是一個補足工具。

首先，下載 X-Ray_tool V5.2 (December 8, 2006)

接著，解壓並仔細閱讀其 README ，按指示 INSTALL。

然後，在寫 Basic 時，先加入下列一句：

BasicLibraries.loadLibrary("XrayTool")

最後，在你想知的「元素」前加入 xray ，如下列：

xray thisComponent

那麼，重要的資料便垂手可得。
　
　　
　

OooBasic 找出 sheet 的使用範圍

　
sub usedArea

　oDoc = thisComponent
　oPlan = oDoc.getSheets().getByIndex(1) '指定是那張 sheet
　oCursor = oPlan.createCursor()
　oCursor.gotoStartOfUsedArea(False)
　oCursor.gotoEndOfUsedArea(True)
　aAdd = oCursor.getRangeAddress()
　print "StartRow=" & aAdd.StartRow+1; ", StartColumn=" & aAdd.StartColumn+1; ", EndRow=" & aAdd.EndRow+1; ", EndColumn" & aAdd.EndColumn+1

end sub
　　
　　
　　

學習記錄：OpenOffice Basic (11) (增加中)

　
一向以來，我是用一個主檔案，以Macro (VBA) 彙集其它同事輸入的資料。方法很簡單，同事們定時輸入資料，我按照 sheet1 儲存格排好的順序，逐一開啟檔案，讀入後關閉，再打開下一個。

以下的程式碼很早找到，只是我一直想用利用 Ooo Basic 兼容 VBA 的特點，儘可能源用已開發的 VBA 碼，減少重寫的幅度，但三天的上網扒文及測試，似乎達不到我的目的。


Sub Main

sFile2 = "C:\Documents and Settings\Administrator\桌面\no2.ods" ' Windows
'C:\Documents and Settings\Administrator\桌面\no2.ods
'sFile = "/home/danny/Desktop/MyCalc.sxc" ' Linux
sURL2 = ConvertToURL(sFile2)
oDoc2 = StarDesktop.loadComponentFromURL(sURL2, "_blank", 0, Array())

sFile1 = "C:\Documents and Settings\Administrator\桌面\no1.ods" ' Windows
'sFile = "/home/danny/Desktop/MyCalc.sxc" ' Linux
sURL1 = ConvertToURL(sFile1)
oDoc1 = StarDesktop.loadComponentFromURL(sURL1, "_blank", 0, Array())

oSheet = oDoc1.sheets (0)
oCell = oSheet.getCellByPosition (0,0)
oCell.String = now 'This function returns the current date and time

REM ##### 將焦點放回第一個開啟的 man_test_oo1.ods
oDoc2.CurrentController.Frame.ContainerWindow.toFront()
oDoc2.CurrentController.Frame.Activate()


oSheet = oDoc2.sheets (0)
oCell = oSheet.getCellByPosition (0,0)
oCell.String = "我是中國人" 'This function returns the current date and time

End Sub