By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
435,538 Members | 2,211 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 435,538 IT Pros & Developers. It's quick & easy.

How to enable macro in open office 3.2

kirubagari
100+
P: 158
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
Sep 21 '10 #1
Share this Question
Share on Google+
3 Replies


kirubagari
100+
P: 158
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
Sep 21 '10 #2

kirubagari
100+
P: 158
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.



Expand|Select|Wrap|Line Numbers
  1. Sub Duplicate
  2.   Dim oDoc As Object, oSheet As Object, oCell As Object, oCell2 As Object, oCell3 As Object, oString As String
  3.   Dim oCells As Object
  4.   Dim oCursors As Object
  5.   Dim aAddresss As Variant
  6.  
  7.   REM Define what sheet to used
  8.   oDoc   =ThisComponent
  9.   oSheet =oDoc.CurrentController.ActiveSheet
  10.   oSheet2=oDoc.Sheets.getByIndex(1) '2nd Sheet
  11.  
  12.   REM Get the value of the LastUsedRow & LastUsedColumn
  13.   oCells = oSheet.GetCellbyPosition(0, 0)
  14.   oCursors = oSheet.createCursorByRange(oCells)
  15.   oCursors.GotoEndOfUsedArea(True)
  16.   aAddress = oCursors.RangeAddress
  17.   LastUsedRow = aAddress.EndRow
  18.   LastUsedColumn = aAddress.EndColumn
  19.  
  20.   'Row2Print=row printed row
  21.   'l=last used row in Sheet2
  22.  
  23.  
  24.   For i=0 to LastUsedRow
  25.    'oCell2=ThisComponent.CurrentSelection.getCellAddress 'Currently Selected Cell
  26.    oSelect=ThisComponent.CurrentSelection.getRangeAddress
  27.    oString = oSheet.GetCellbyPosition(oSelect.StartColumn, i).getString() 'IMPORTANT (Need Revision)
  28.    'getCellByPosition(Column,Row)
  29.    oRight = Val(Right(oString,Len(oString)-InStr(1, oString, "-")))
  30.    oLeft =  Val(Left(oString,Len(oString)-InStr(1, oString, "-")))
  31.    Row2Print = oRight - oLeft
  32.    oRangeOrg = oSheet.getCellRangeByName("A"&(i+1)&":O"&(i+1)).RangeAddress   ' copy range
  33.  
  34.     REM Begin Pasting the Value 
  35.     For j=0 to Row2Print
  36.    k=k+1
  37.      oRangeCpy = oSheet2.getCellRangeByName("B"&k).RangeAddress ' insert range
  38.      oCellCpy = oSheet2.getCellByPosition(oRangeCpy.StartColumn,oRangeCpy.StartRow).CellAddress ' insert position
  39.      oSheet.CopyRange(oCellCpy, oRangeOrg) ' copy
  40.     Next
  41.  
  42.    'oSheet2=oDoc.Sheets.getByIndex(1) '2nd Sheet 
  43.    'oCells = oSheet2.GetCellbyPosition(0, 0)
  44.    'oCursors = oSheet2.createCursorByRange(oCells)
  45.    'oCursors.GotoEndOfUsedArea(True)
  46.    'aAddress = oCursors.RangeAddress
  47.    'LastUsedRow = aAddress.EndRow
  48.    'LastUsedColumn = aAddress.EndColumn 
  49.  
  50.     For l=0 to Row2Print
  51.      oCell4=oSheet2.getCellByPosition(0,m) 'A1
  52.      oCell4.setString(oLeft)
  53.      oLeft=oLeft+1
  54.      m=m+1
  55.     Next 
  56.   Next i
  57.   'oCell.NumberFormat=2   '23658.00
  58.   'oCell.SetValue(12345)
  59.   'oCell.SetString("oops")
  60.   'oCell.setFormula("=FUNCTION()")
  61.   'oCell.IsCellBackgroundTransparent = TRUE
  62.   'oCell.CellBackColor = RGB(255,141,56)
  63. End Sub
  64.  
  65. Function GetLastUsedRow(oSheets as Object) as Integer
  66. Dim oCells As Object
  67. Dim oCursors As Object
  68. Dim aAddresss As Variant
  69.  
  70. oCells = oSheets.GetCellbyPosition(0, 0)
  71. oCursors = oSheets.createCursorByRange(oCells)
  72. oCursors.GotoEndOfUsedArea(True)
  73. aAddresss = oCursors.RangeAddress
  74. GetLastUsedRow = aAddresss.EndRow
  75. End Function
  76.  
  77. Function GetLastUsedColumn(oSheet as Object) as Integer
  78.   Dim oCell As Object
  79.   Dim oCursor As Object
  80.   Dim aAddress As Variant
  81.   oCell = oSheet.GetCellbyPosition( 0, 0 )
  82.   oCursor = oSheet.createCursorByRange(oCell)
  83.   oCursor.GotoEndOfUsedArea(True)
  84.   aAddress = oCursor.RangeAddress
  85.   GetLastUsedColumn = aAddress.EndColumn
  86. End Function
  87.  
  88. Sub SelRow()
  89.   Dim oSheet
  90.   Dim oRow
  91.   oSheet = ThisComponent.getSheets().getByIndex(0)
  92.   oRow = oSheet.getRows().getByIndex(2)
  93.   ThisComponent.getCurrentController().select(oRow)
  94. End Sub
  95.  
  96. Sub CopySpreadsheetRange
  97.   oSheet1 = ThisComponent.Sheets.getByIndex(0)    ' sheet no 1, original
  98.   oSheet2 = ThisComponent.Sheets.getByIndex(1)    ' sheet no 2
  99.  
  100.   oRangeOrg = oSheet1.getCellRangeByName("A1:C10").RangeAddress   ' copy range
  101.   oRangeCpy = oSheet2.getCellRangeByName("A1:C10").RangeAddress   ' insert range
  102.  
  103.   oCellCpy = oSheet2.getCellByPosition(oRangeCpy.StartColumn,_
  104.     oRangeCpy.StartRow).CellAddress ' insert position
  105.  
  106.   oSheet1.CopyRange(oCellCpy, oRangeOrg)                  ' copy
  107. End Sub
  108. '----------------------------------------------------------------------------------------
  109.  
  110. Function IsSpreadsheetDoc(oDoc) As Boolean
  111.   Dim s$ : s$ = "com.sun.star.sheet.SpreadsheetDocument"
  112.   IsSpreadsheetDoc = oDoc.SupportsService(s$)
  113. End Function
  114.  
  115. Sub checking( )
  116.   MsgBox IsSpreadsheetDoc(thisComponent)
  117. End Sub
  118.  
  119. Sub ExampleGetValue
  120.   Dim oDoc As Object, oSheet As Object, oCell As Object
  121.   oDoc=ThisComponent
  122.   oSheet=oDoc.Sheets.getByName("Sheet1")
  123.   oCell=oSheet.getCellByposition(0,0) 'A1
  124.   Rem a cell's contents can have one of the three following types:
  125.   Print oCell.getValue()
  126.   'Print oCell.getString()
  127.   'Print oCell.getFormula()
  128. End Sub
  129.  
  130. Sub SelectedCells 
  131.   oSelect=ThisComponent.CurrentSelection.getRangeAddress
  132.   oSelectColumn=ThisComponent.CurrentSelection.Columns
  133.   oSelectRow=ThisComponent.CurrentSelection.Rows
  134.  
  135.   CountColumn=oSelectColumn.getCount
  136.   CountRow=oSelectRow.getCount
  137.  
  138.   oSelectSC=oSelectColumn.getByIndex(0).getName
  139.   oSelectEC=oSelectColumn.getByIndex(CountColumn-1).getName
  140.  
  141.   oSelectSR=oSelect.StartRow+1
  142.   oSelectER=oSelect.EndRow+1
  143.   NoCell=(CountColumn*CountRow)
  144.  
  145.   If CountColumn=1 AND CountRow=1 Then
  146.     MsgBox("Cell " + oSelectSC + oSelectSR + chr(13) + "Cell No = " + NoCell,, "SelectedCells")
  147.   Else
  148.     MsgBox("Range(" + oSelectSC + oSelectSR + ":" + oSelectEC + oSelectER + ")" + chr(13) + "Cell No = " + NoCell,, "SelectedCells") 
  149.   End If
  150. End Sub
  151.  
  152. Sub Analize
  153.   sSum="=SUM("+GetAddress+")"
  154.   sAverage="=AVERAGE("+GetAddress+")"
  155.   sMin="=MIN("+GetAddress+")"
  156.   sMax="=MAX("+GetAddress+")"
  157.   CellPos(7,6).setString(GetAddress)
  158.   CellPos(7,8).setFormula(sSum)
  159.   CellPos(7,8).NumberFormat=2
  160.   CellPos(7,10).setFormula(sAverage)
  161.   CellPos(7,10).NumberFormat=2
  162.   CellPos(7,12).setFormula(sMin)
  163.   CellPos(7,12).NumberFormat=2
  164.   CellPos(7,14).setFormula(sMax)
  165.   CellPos(7,14).NumberFormat=2
  166. End sub
  167.  
  168. Function GetAddress  'selected cell(s)
  169.   oSelect=ThisComponent.CurrentSelection.getRangeAddress
  170.   oSelectColumn=ThisComponent.CurrentSelection.Columns
  171.   oSelectRow=ThisComponent.CurrentSelection.Rows
  172.  
  173.   CountColumn=oSelectColumn.getCount
  174.   CountRow=oSelectRow.getCount
  175.  
  176.   oSelectSC=oSelectColumn.getByIndex(0).getName
  177.   oSelectEC=oSelectColumn.getByIndex(CountColumn-1).getName
  178.  
  179.   oSelectSR=oSelect.StartRow+1
  180.   oSelectER=oSelect.EndRow+1
  181.   NoCell=(CountColumn*CountRow)
  182.  
  183.   If CountColumn=1 AND CountRow=1 then  
  184.     GetAddress=oSelectSC+oSelectSR  
  185.   Else  
  186.     GetAddress=oSelectSC+oSelectSR+":"+oSelectEC+oSelectER 
  187.   End If
  188. End Function
  189. Function CellPos(lColumn As Long,lRow As Long)
  190.   CellPos= ActiveSheet.getCellByPosition (lColumn,lRow)
  191. End Function
  192. Function ActiveSheet
  193.   ActiveSheet=StarDesktop.CurrentComponent.CurrentController.ActiveSheet
  194. End Function
  195. Sub DeleteDbRange(sRangeName As String)    
  196.   oRange=ThisComponent.DatabaseRanges
  197.   oRange.removeByName (sRangeName)
  198. End Sub
Sep 21 '10 #3

kirubagari
100+
P: 158
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?
Attached Files
File Type: zip MessageAttachments.zip (340.0 KB, 78 views)
Sep 21 '10 #4

Post your reply

Sign in to post your reply or Sign up for a free account.