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.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.getCellAddr ess 'Currently Selected Cell
oSelect=ThisComponent.CurrentSelection.getRangeAdd ress
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)).Ra ngeAddress ' 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,oR angeCpy.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.getRangeAdd ress
oSelectColumn=ThisComponent.CurrentSelection.Colum ns
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.getRangeAdd ress
oSelectColumn=ThisComponent.CurrentSelection.Colum ns
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+oSele ctER
End If
End Function
Function CellPos(lColumn As Long,lRow As Long)
CellPos= ActiveSheet.getCellByPosition (lColumn,lRow)
End Function
Function ActiveSheet
ActiveSheet=StarDesktop.CurrentComponent.CurrentCo ntroller.ActiveSheet
End Function
Sub DeleteDbRange(sRangeName As String)
oRange=ThisComponent.DatabaseRanges
oRange.removeByName (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]

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?