How to enable macro in open office 3.2

[kirubagari]

I would like to duplicate the numbers from from excel sheet 1 to excel sheet 2.Kindly help me on this.Sometime its unable to duplicate..



Sub Duplicate
Dim oDoc As Object, oSheet As Object, oCell As Object, oCell2 As Object, oCell3 As Object, oString As String
Dim oCells As Object
Dim oCursors As Object
Dim aAddresss As Variant

REM Define what sheet to used
oDoc =ThisComponent
oSheet =oDoc.CurrentCo ntroller.Active Sheet
oSheet2=oDoc.Sh eets.getByIndex (1) '2nd Sheet

REM Get the value of the LastUsedRow & LastUsedColumn
oCells = oSheet.GetCellb yPosition(0, 0)
oCursors = oSheet.createCu rsorByRange(oCe lls)
oCursors.GotoEn dOfUsedArea(Tru e)
aAddress = oCursors.RangeA ddress
LastUsedRow = aAddress.EndRow
LastUsedColumn = aAddress.EndCol umn

'Row2Print=row printed row
'l=last used row in Sheet2


For i=0 to LastUsedRow
'oCell2=ThisCom ponent.CurrentS election.getCel lAddress 'Currently Selected Cell
oSelect=ThisCom ponent.CurrentS election.getRan geAddress
oString = oSheet.GetCellb yPosition(oSele ct.StartColumn, i).getString() 'IMPORTANT (Need Revision)
'getCellByPosit ion(Column,Row)
oRight = Val(Right(oStri ng,Len(oString)-InStr(1, oString, "-")))
oLeft = Val(Left(oStrin g,Len(oString)-InStr(1, oString, "-")))
Row2Print = oRight - oLeft
oRangeOrg = oSheet.getCellR angeByName("A"& (i+1)&":O"&(i+1 )).RangeAddress ' copy range

REM Begin Pasting the Value
For j=0 to Row2Print
k=k+1
oRangeCpy = oSheet2.getCell RangeByName("B" &k).RangeAddres s ' insert range
oCellCpy = oSheet2.getCell ByPosition(oRan geCpy.StartColu mn,oRangeCpy.St artRow).CellAdd ress ' insert position
oSheet.CopyRang e(oCellCpy, oRangeOrg) ' copy
Next

'oSheet2=oDoc.S heets.getByInde x(1) '2nd Sheet
'oCells = oSheet2.GetCell byPosition(0, 0)
'oCursors = oSheet2.createC ursorByRange(oC ells)
'oCursors.GotoE ndOfUsedArea(Tr ue)
'aAddress = oCursors.RangeA ddress
'LastUsedRow = aAddress.EndRow
'LastUsedColumn = aAddress.EndCol umn

For l=0 to Row2Print
oCell4=oSheet2. getCellByPositi on(0,m) 'A1
oCell4.setStrin g(oLeft)
oLeft=oLeft+1
m=m+1
Next
Next i
'oCell.NumberFo rmat=2 '23658.00
'oCell.SetValue (12345)
'oCell.SetStrin g("oops")
'oCell.setFormu la("=FUNCTION() ")
'oCell.IsCellBa ckgroundTranspa rent = TRUE
'oCell.CellBack Color = RGB(255,141,56)
End Sub

Function GetLastUsedRow( oSheets as Object) as Integer
Dim oCells As Object
Dim oCursors As Object
Dim aAddresss As Variant

oCells = oSheets.GetCell byPosition(0, 0)
oCursors = oSheets.createC ursorByRange(oC ells)
oCursors.GotoEn dOfUsedArea(Tru e)
aAddresss = oCursors.RangeA ddress
GetLastUsedRow = aAddresss.EndRo w
End Function

Function GetLastUsedColu mn(oSheet as Object) as Integer
Dim oCell As Object
Dim oCursor As Object
Dim aAddress As Variant
oCell = oSheet.GetCellb yPosition( 0, 0 )
oCursor = oSheet.createCu rsorByRange(oCe ll)
oCursor.GotoEnd OfUsedArea(True )
aAddress = oCursor.RangeAd dress
GetLastUsedColu mn = aAddress.EndCol umn
End Function

Sub SelRow()
Dim oSheet
Dim oRow
oSheet = ThisComponent.g etSheets().getB yIndex(0)
oRow = oSheet.getRows( ).getByIndex(2)
ThisComponent.g etCurrentContro ller().select(o Row)
End Sub

Sub CopySpreadsheet Range
oSheet1 = ThisComponent.S heets.getByInde x(0) ' sheet no 1, original
oSheet2 = ThisComponent.S heets.getByInde x(1) ' sheet no 2

oRangeOrg = oSheet1.getCell RangeByName("A1 :C10").RangeAdd ress ' copy range
oRangeCpy = oSheet2.getCell RangeByName("A1 :C10").RangeAdd ress ' insert range

oCellCpy = oSheet2.getCell ByPosition(oRan geCpy.StartColu mn,_
oRangeCpy.Start Row).CellAddres s ' insert position

oSheet1.CopyRan ge(oCellCpy, oRangeOrg) ' copy
End Sub
'----------------------------------------------------------------------------------------

Function IsSpreadsheetDo c(oDoc) As Boolean
Dim s$ : s$ = "com.sun.star.s heet.Spreadshee tDocument"
IsSpreadsheetDo c = oDoc.SupportsSe rvice(s$)
End Function

Sub checking( )
MsgBox IsSpreadsheetDo c(thisComponent )
End Sub

Sub ExampleGetValue
Dim oDoc As Object, oSheet As Object, oCell As Object
oDoc=ThisCompon ent
oSheet=oDoc.She ets.getByName(" Sheet1")
oCell=oSheet.ge tCellByposition (0,0) 'A1
Rem a cell's contents can have one of the three following types:
Print oCell.getValue( )
'Print oCell.getString ()
'Print oCell.getFormul a()
End Sub

Sub SelectedCells
oSelect=ThisCom ponent.CurrentS election.getRan geAddress
oSelectColumn=T hisComponent.Cu rrentSelection. Columns
oSelectRow=This Component.Curre ntSelection.Row s

CountColumn=oSe lectColumn.getC ount
CountRow=oSelec tRow.getCount

oSelectSC=oSele ctColumn.getByI ndex(0).getName
oSelectEC=oSele ctColumn.getByI ndex(CountColum n-1).getName

oSelectSR=oSele ct.StartRow+1
oSelectER=oSele ct.EndRow+1
NoCell=(CountCo lumn*CountRow)

If CountColumn=1 AND CountRow=1 Then
MsgBox("Cell " + oSelectSC + oSelectSR + chr(13) + "Cell No = " + NoCell,, "SelectedCells" )
Else
MsgBox("Range(" + oSelectSC + oSelectSR + ":" + oSelectEC + oSelectER + ")" + chr(13) + "Cell No = " + NoCell,, "SelectedCells" )
End If
End Sub

Sub Analize
sSum="=SUM("+Ge tAddress+")"
sAverage="=AVER AGE("+GetAddres s+")"
sMin="=MIN("+Ge tAddress+")"
sMax="=MAX("+Ge tAddress+")"
CellPos(7,6).se tString(GetAddr ess)
CellPos(7,8).se tFormula(sSum)
CellPos(7,8).Nu mberFormat=2
CellPos(7,10).s etFormula(sAver age)
CellPos(7,10).N umberFormat=2
CellPos(7,12).s etFormula(sMin)
CellPos(7,12).N umberFormat=2
CellPos(7,14).s etFormula(sMax)
CellPos(7,14).N umberFormat=2
End sub

Function GetAddress 'selected cell(s)
oSelect=ThisCom ponent.CurrentS election.getRan geAddress
oSelectColumn=T hisComponent.Cu rrentSelection. Columns
oSelectRow=This Component.Curre ntSelection.Row s

CountColumn=oSe lectColumn.getC ount
CountRow=oSelec tRow.getCount

oSelectSC=oSele ctColumn.getByI ndex(0).getName
oSelectEC=oSele ctColumn.getByI ndex(CountColum n-1).getName

oSelectSR=oSele ct.StartRow+1
oSelectER=oSele ct.EndRow+1
NoCell=(CountCo lumn*CountRow)

If CountColumn=1 AND CountRow=1 then
GetAddress=oSel ectSC+oSelectSR
Else
GetAddress=oSel ectSC+oSelectSR +":"+oSelectEC+ oSelectER
End If
End Function
Function CellPos(lColumn As Long,lRow As Long)
CellPos= ActiveSheet.get CellByPosition (lColumn,lRow)
End Function
Function ActiveSheet
ActiveSheet=Sta rDesktop.Curren tComponent.Curr entController.A ctiveSheet
End Function
Sub DeleteDbRange(s RangeName As String)
oRange=ThisComp onent.DatabaseR anges
oRange.removeBy Name (sRangeName)
End Sub

[kirubagari]

Need help since i'm doing the macro in VB.Kindly advice.

Im able to use the duplicate function and its sometime works and sometime doesnt work

Kindly assit me

[kirubagari]

Use macro that using in open office 3.2 excel sheet to generate result in 2nd sheet

I would like to duplicate the data in open office 3.2 since there is alot of date in the sheet 1.I have to filter the data and assign the value to the employee.

For eg:U ser will key in the name (column A)in the excel sheet open office and voucher number (column C) and also the price of the voucher in column B.
Lets say hong wai kit voucher number 58419-58421 and Ang yin yin 58422-58424


The sheet 2 will auto generate out and
Notice the Adrin hong wai kit 58419-58421 and Ang yin yin 58422-58424
the adrin hong wai kit will come out three (system will calculate out how may voucher this customer have)three voucher

Below is my coding ..I need help on how to make duplicate the voucher number accoring to the name also the voucher price.

Sub Duplicate
  Dim oDoc As Object, oSheet As Object, oCell As Object, oCell2 As Object, oCell3 As Object, oString As String
  Dim oCells As Object
  Dim oCursors As Object
  Dim aAddresss As Variant
  
  REM Define what sheet to used
  oDoc   =ThisComponent
  oSheet =oDoc.CurrentController.ActiveSheet
  oSheet2=oDoc.Sheets.getByIndex(1) '2nd Sheet
  
  REM Get the value of the LastUsedRow & LastUsedColumn
  oCells = oSheet.GetCellbyPosition(0, 0)
  oCursors = oSheet.createCursorByRange(oCells)
  oCursors.GotoEndOfUsedArea(True)
  aAddress = oCursors.RangeAddress
  LastUsedRow = aAddress.EndRow
  LastUsedColumn = aAddress.EndColumn
 
  'Row2Print=row printed row
  'l=last used row in Sheet2
  
  
  For i=0 to LastUsedRow
   'oCell2=ThisComponent.CurrentSelection.getCellAddress 'Currently Selected Cell
   oSelect=ThisComponent.CurrentSelection.getRangeAddress
   oString = oSheet.GetCellbyPosition(oSelect.StartColumn, i).getString() 'IMPORTANT (Need Revision)
   'getCellByPosition(Column,Row)
   oRight = Val(Right(oString,Len(oString)-InStr(1, oString, "-")))
   oLeft =  Val(Left(oString,Len(oString)-InStr(1, oString, "-")))
   Row2Print = oRight - oLeft
   oRangeOrg = oSheet.getCellRangeByName("A"&(i+1)&":O"&(i+1)).RangeAddress   ' copy range
   
    REM Begin Pasting the Value 
    For j=0 to Row2Print
   k=k+1
     oRangeCpy = oSheet2.getCellRangeByName("B"&k).RangeAddress ' insert range
     oCellCpy = oSheet2.getCellByPosition(oRangeCpy.StartColumn,oRangeCpy.StartRow).CellAddress ' insert position
     oSheet.CopyRange(oCellCpy, oRangeOrg) ' copy
    Next
   
   'oSheet2=oDoc.Sheets.getByIndex(1) '2nd Sheet 
   'oCells = oSheet2.GetCellbyPosition(0, 0)
   'oCursors = oSheet2.createCursorByRange(oCells)
   'oCursors.GotoEndOfUsedArea(True)
   'aAddress = oCursors.RangeAddress
   'LastUsedRow = aAddress.EndRow
   'LastUsedColumn = aAddress.EndColumn 
    
    For l=0 to Row2Print
     oCell4=oSheet2.getCellByPosition(0,m) 'A1
     oCell4.setString(oLeft)
     oLeft=oLeft+1
     m=m+1
    Next 
  Next i
  'oCell.NumberFormat=2   '23658.00
  'oCell.SetValue(12345)
  'oCell.SetString("oops")
  'oCell.setFormula("=FUNCTION()")
  'oCell.IsCellBackgroundTransparent = TRUE
  'oCell.CellBackColor = RGB(255,141,56)
End Sub
 
Function GetLastUsedRow(oSheets as Object) as Integer
Dim oCells As Object
Dim oCursors As Object
Dim aAddresss As Variant
 
oCells = oSheets.GetCellbyPosition(0, 0)
oCursors = oSheets.createCursorByRange(oCells)
oCursors.GotoEndOfUsedArea(True)
aAddresss = oCursors.RangeAddress
GetLastUsedRow = aAddresss.EndRow
End Function
 
Function GetLastUsedColumn(oSheet as Object) as Integer
  Dim oCell As Object
  Dim oCursor As Object
  Dim aAddress As Variant
  oCell = oSheet.GetCellbyPosition( 0, 0 )
  oCursor = oSheet.createCursorByRange(oCell)
  oCursor.GotoEndOfUsedArea(True)
  aAddress = oCursor.RangeAddress
  GetLastUsedColumn = aAddress.EndColumn
End Function
 
Sub SelRow()
  Dim oSheet
  Dim oRow
  oSheet = ThisComponent.getSheets().getByIndex(0)
  oRow = oSheet.getRows().getByIndex(2)
  ThisComponent.getCurrentController().select(oRow)
End Sub
 
Sub CopySpreadsheetRange
  oSheet1 = ThisComponent.Sheets.getByIndex(0)    ' sheet no 1, original
  oSheet2 = ThisComponent.Sheets.getByIndex(1)    ' sheet no 2
 
  oRangeOrg = oSheet1.getCellRangeByName("A1:C10").RangeAddress   ' copy range
  oRangeCpy = oSheet2.getCellRangeByName("A1:C10").RangeAddress   ' insert range
 
  oCellCpy = oSheet2.getCellByPosition(oRangeCpy.StartColumn,_
    oRangeCpy.StartRow).CellAddress ' insert position
 
  oSheet1.CopyRange(oCellCpy, oRangeOrg)                  ' copy
End Sub
'----------------------------------------------------------------------------------------
 
Function IsSpreadsheetDoc(oDoc) As Boolean
  Dim s$ : s$ = "com.sun.star.sheet.SpreadsheetDocument"
  IsSpreadsheetDoc = oDoc.SupportsService(s$)
End Function
 
Sub checking( )
  MsgBox IsSpreadsheetDoc(thisComponent)
End Sub
 
Sub ExampleGetValue
  Dim oDoc As Object, oSheet As Object, oCell As Object
  oDoc=ThisComponent
  oSheet=oDoc.Sheets.getByName("Sheet1")
  oCell=oSheet.getCellByposition(0,0) 'A1
  Rem a cell's contents can have one of the three following types:
  Print oCell.getValue()
  'Print oCell.getString()
  'Print oCell.getFormula()
End Sub
 
Sub SelectedCells 
  oSelect=ThisComponent.CurrentSelection.getRangeAddress
  oSelectColumn=ThisComponent.CurrentSelection.Columns
  oSelectRow=ThisComponent.CurrentSelection.Rows
 
  CountColumn=oSelectColumn.getCount
  CountRow=oSelectRow.getCount
 
  oSelectSC=oSelectColumn.getByIndex(0).getName
  oSelectEC=oSelectColumn.getByIndex(CountColumn-1).getName
 
  oSelectSR=oSelect.StartRow+1
  oSelectER=oSelect.EndRow+1
  NoCell=(CountColumn*CountRow)
 
  If CountColumn=1 AND CountRow=1 Then
    MsgBox("Cell " + oSelectSC + oSelectSR + chr(13) + "Cell No = " + NoCell,, "SelectedCells")
  Else
    MsgBox("Range(" + oSelectSC + oSelectSR + ":" + oSelectEC + oSelectER + ")" + chr(13) + "Cell No = " + NoCell,, "SelectedCells") 
  End If
End Sub
 
Sub Analize
  sSum="=SUM("+GetAddress+")"
  sAverage="=AVERAGE("+GetAddress+")"
  sMin="=MIN("+GetAddress+")"
  sMax="=MAX("+GetAddress+")"
  CellPos(7,6).setString(GetAddress)
  CellPos(7,8).setFormula(sSum)
  CellPos(7,8).NumberFormat=2
  CellPos(7,10).setFormula(sAverage)
  CellPos(7,10).NumberFormat=2
  CellPos(7,12).setFormula(sMin)
  CellPos(7,12).NumberFormat=2
  CellPos(7,14).setFormula(sMax)
  CellPos(7,14).NumberFormat=2
End sub
 
Function GetAddress  'selected cell(s)
  oSelect=ThisComponent.CurrentSelection.getRangeAddress
  oSelectColumn=ThisComponent.CurrentSelection.Columns
  oSelectRow=ThisComponent.CurrentSelection.Rows
 
  CountColumn=oSelectColumn.getCount
  CountRow=oSelectRow.getCount
 
  oSelectSC=oSelectColumn.getByIndex(0).getName
  oSelectEC=oSelectColumn.getByIndex(CountColumn-1).getName
 
  oSelectSR=oSelect.StartRow+1
  oSelectER=oSelect.EndRow+1
  NoCell=(CountColumn*CountRow)
 
  If CountColumn=1 AND CountRow=1 then  
    GetAddress=oSelectSC+oSelectSR  
  Else  
    GetAddress=oSelectSC+oSelectSR+":"+oSelectEC+oSelectER 
  End If
End Function
Function CellPos(lColumn As Long,lRow As Long)
  CellPos= ActiveSheet.getCellByPosition (lColumn,lRow)
End Function
Function ActiveSheet
  ActiveSheet=StarDesktop.CurrentComponent.CurrentController.ActiveSheet
End Function
Sub DeleteDbRange(sRangeName As String)    
  oRange=ThisComponent.DatabaseRanges
  oRange.removeByName (sRangeName)
End Sub

[kirubagari]

I have some attachement so that experts can understand my problem.i have come with my coding but the issue is its not intemetainly working


Attachment one
The voucher is look like this..
user will key in the name (column A) and voucher number (column C)
you notice that the first one Adrin hong wai kit 58419-58421 and Ang yin yin 58422-58424

Attachment two is the button that duplicate.


Attachment Three is after click the duplicate, the sheet 2 will auto generate out..
Notice the Adrin hong wai kit 58419-58421 and Ang yin yin 58422-58424
the adrin hong wai kit will come out three (system will calculate out how may voucher this customer have)

KINDLY HELP HOW I CAN EDIT THE CODING SO THAT MORE ACCURATE?