0

I am trying to create a macro in open office however i cant find away to perform this. I want to copy a specific cell and the past a blank sell on a given column.

Basically its something like this

Copy "B2"
If "A1" blank paste
if false
move 1 cell lower
end if

Something like this, i spent a lot of time drawing the flow chart and trying to get the programming right but i just crash on this. I appreciate any response or guideline to find the correct answer thank you.

pnuts
  • 58,317
  • 11
  • 87
  • 139
user3513345
  • 1
  • 2

1 Answers1

0

someone just gave me the answer on aoo forums thanks though =COUNTA(Sheet2.A1:A2)

Sub Copy2FirstBlankCell()
   Dim oDoc As Object
   Dim oSheet As Object
   Dim SourceAddress As New com.sun.star.table.CellRangeAddress
   Dim DestinationAddress As New com.sun.star.table.CellAddress
   Dim DestinationCell As Object
   Dim r As Long
   Dim c As Integer

   oDoc = ThisComponent
   oSheet = oDoc.getSheets().getByIndex(0)

   'CellrangeAddress of Sheet1.B1
   SourceAddress.Sheet = 0
   SourceAddress.StartColumn = 1
   SourceAddress.StartRow = 0
   SourceAddress.EndColumn = 1
   SourceAddress.EndRow = 0

   'CellAddress of Sheet1.A1
   r = 0
   c = 0
   DestinationAddress.Sheet = 0
   DestinationAddress.Column = c
   DestinationAddress.Row = r

   DestinationCell = oDoc.getSheets().getByIndex(DestinationAddress.Sheet).getCellByPosition(c,r)
   Do While DestinationCell.getType() <> com.sun.star.table.CellContentType.EMPTY And r < oSheet.getRows().getCount()
      r = r + 1
      DestinationAddress.Row = r
      DestinationCell = oDoc.getSheets().getByIndex(DestinationAddress.Sheet).getCellByPosition(c,r)
   Loop
   If DestinationCell.getType() = com.sun.star.table.CellContentType.EMPTY Then
      oSheet.copyRange(DestinationAddress,SourceAddress)
   Else
      Msgbox("Ran out of rows.")
   end if
End Sub

Also added a few more helpfull details i might find.

Time Stamp

Sub PutNowInCurrentCell
   Dim oDoc As Object
   Dim oSel As Object
   Dim svc as Object

   svc = createUnoService( "com.sun.star.sheet.FunctionAccess" )  'Create a service to use Calc functions

   oDoc = ThisComponent
   oSel = oDoc.getCurrentSelection()
   if oSel.supportsService("com.sun.star.sheet.SheetCell") then
      oSel.NumberFormat = getFormat("HH:MM:SS AM/PM")
      oSel.Value =  svc.callFunction("NOW",Array())
   endif

End Sub

Function getformat(f As String) As Long
   Dim oDoc As Object
   Dim NumberFormats As Object
   Dim Loc as New com.sun.star.lang.Locale
   Dim formatID As Long

   oDoc = ThisComponent

   Loc = oDoc.CharLocale

   NumberFormats = oDoc.NumberFormats

   formatId = NumberFormats.queryKey(f, Loc, False)
   If formatId = -1 Then
      formatId = NumberFormats.addNew(f, Loc)
   End If

   getformat  = formatID

End Function

Minimizer

sub Minimizer()

   dim document   as object
   dim dispatcher as object

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

   dim args1(0) as new com.sun.star.beans.PropertyValue
   args1(0).Name = "ToPoint"
   args1(0).Value = "$D$10:$E$12"  ' select what is to be copied

   dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args1())


   dispatcher.executeDispatch(document, ".uno:Copy", "", 0, Array())


   dim args3(0) as new com.sun.star.beans.PropertyValue
   args3(0).Name = "ToPoint"
   args3(0).Value = "$C$10"    ' select where i will be paste

   dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args3())
   dispatcher.executeDispatch(document, ".uno:SetInputMode", "", 0, Array())

   dispatcher.executeDispatch(document, ".uno:Paste", "", 0, Array())


   dim args5(0) as new com.sun.star.beans.PropertyValue
   args5(0).Name = "ToPoint"
   args5(0).Value = "$D$9"

   dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args5())

end sub

--あなたの若さをだれにも見下げられることのないようにしなさい

user3513345
  • 1
  • 2