(轉載) 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