Simple loop to run a macro to the end of a document

[Nemesis]

I've created a short macro (by recording), and I simply want to run it several times untill it reaches the end of the document. (why isn't there a function in oo, like "run script xx times?")

I'm very seldom using this, so I have no idea what to do?

Code: Select all

REM  *****  BASIC  *****

Sub Main

End Sub

Sub fitGraphics()

   Dim oDoc As Object
   Dim oSheet As Object
   Dim aCell As Object
   Dim g as Object
   Dim c As Integer
   Dim s As new com.sun.star.awt.Size
   Dim gp As new com.sun.star.awt.Point     
   Dim ap As new com.sun.star.awt.Point     
   Dim p As new com.sun.star.awt.Point     
   Dim xAdjust As Long
   Dim yAdjust As Long
   Dim rowHeight As Long
   Dim colWidth As Long
   
   oDoc = ThisComponent
   
   oSheet = oDoc.CurrentController.ActiveSheet
   
   c = oSheet.DrawPage.count
   
   Do While c >= 1
         g = oSheet.DrawPage(c - 1)
         if InStr(g.ShapeType,"GraphicObjectShape") > 0 then
            s = g.getSize()
            gp = g.getPosition()
            aCell = g.anchor
            rowHeight = oSheet.Rows(aCell.CellAddress.Row).Height
            colWidth = oSheet.Columns(g.anchor.CellAddress.Column).Width
            
            if rowHeight < s.Height then
               oSheet.Rows(aCell.CellAddress.Row).Height = s.Height
               yAdjust = 0
         else
            yAdjust = (rowHeight - s.Height) \ 2
         endif
         if colWidth < s.Width then
               oSheet.Columns(aCell.CellAddress.Column).Width = s.Width
               xAdjust = 0
         else
            xAdjust = (colWidth - s.Width) \ 2
         endif      
            ap = aCell.Position()
            gp = g.getPosition()
            if (rowHeight < s.Height) or colWidth < s.Width then
               g.setSize(s)
               g.setPosition(ap)
            else
               p.X = ap.X + xAdjust
               p.Y = ap.Y + yAdjust
               g.setPosition(p)
            endif
         endif
         c = c - 1
   Loop
   
End Sub


sub test
rem ----------------------------------------------------------------------
rem define variables
dim document   as object
dim dispatcher as object
rem ----------------------------------------------------------------------
rem get access to the document
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

rem ----------------------------------------------------------------------
rem dispatcher.executeDispatch(document, ".uno:OriginalSize", "", 0, Array())


end sub


sub test2
rem ----------------------------------------------------------------------
rem define variables
dim document   as object
dim dispatcher as object
rem ----------------------------------------------------------------------
rem get access to the document
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

rem ----------------------------------------------------------------------
dim args1(7) as new com.sun.star.beans.PropertyValue
args1(0).Name = "BorderOuter.LeftBorder"
args1(0).Value = Array(0,0,0,0)
args1(1).Name = "BorderOuter.LeftDistance"
args1(1).Value = 0
args1(2).Name = "BorderOuter.RightBorder"
args1(2).Value = Array(0,0,0,0)
args1(3).Name = "BorderOuter.RightDistance"
args1(3).Value = 0
args1(4).Name = "BorderOuter.TopBorder"
args1(4).Value = Array(0,0,0,0)
args1(5).Name = "BorderOuter.TopDistance"
args1(5).Value = 0
args1(6).Name = "BorderOuter.BottomBorder"
args1(6).Value = Array(0,0,2,0)
args1(7).Name = "BorderOuter.BottomDistance"
args1(7).Value = 0

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

rem ----------------------------------------------------------------------
dispatcher.executeDispatch(document, ".uno:InsertRows", "", 0, Array())


end sub


sub days7
rem ----------------------------------------------------------------------
rem define variables
dim document   as object
dim dispatcher as object
rem ----------------------------------------------------------------------
rem get access to the document
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

rem ----------------------------------------------------------------------
dispatcher.executeDispatch(document, ".uno:InsertRows", "", 0, Array())

rem ----------------------------------------------------------------------
dim args2(7) as new com.sun.star.beans.PropertyValue
args2(0).Name = "BorderOuter.LeftBorder"
args2(0).Value = Array(0,0,0,0)
args2(1).Name = "BorderOuter.LeftDistance"
args2(1).Value = 0
args2(2).Name = "BorderOuter.RightBorder"
args2(2).Value = Array(0,0,0,0)
args2(3).Name = "BorderOuter.RightDistance"
args2(3).Value = 0
args2(4).Name = "BorderOuter.TopBorder"
args2(4).Value = Array(0,0,0,0)
args2(5).Name = "BorderOuter.TopDistance"
args2(5).Value = 0
args2(6).Name = "BorderOuter.BottomBorder"
args2(6).Value = Array(0,0,0,0)
args2(7).Name = "BorderOuter.BottomDistance"
args2(7).Value = 0

dispatcher.executeDispatch(document, ".uno:BorderOuter", "", 0, args2())

rem ----------------------------------------------------------------------
dim args3(4) as new com.sun.star.beans.PropertyValue
args3(0).Name = "BorderInner.Horizontal"
args3(0).Value = Array(0,0,0,0)
args3(1).Name = "BorderInner.Vertical"
args3(1).Value = Array(0,0,0,0)
args3(2).Name = "BorderInner.Flags"
args3(2).Value = 2
args3(3).Name = "BorderInner.ValidFlags"
args3(3).Value = 125
args3(4).Name = "BorderInner.DefaultDistance"
args3(4).Value = 0

dispatcher.executeDispatch(document, ".uno:BorderInner", "", 0, args3())

rem ----------------------------------------------------------------------
dim args4(0) as new com.sun.star.beans.PropertyValue
args4(0).Name = "RowHeight"
args4(0).Value = 0

dispatcher.executeDispatch(document, ".uno:RowHeight", "", 0, args4())


end sub

[Zizi64]

As you can get the number of the DrawPages on a single Sheet (there is only one per Sheet in a Spreadsheet file), so you can get the number of the Sheets, too; and you can create an another (outer) loop for the sheets.

(why isn't there a function in oo, like "run script xx times?")

There is: the "for...next" cycle.


The Macro Recorder has a limited capability. You must WRITE your macros (based on the API function and procedures) instead recording them - if you want to work with the macros efficiently.

[Nemesis]

There is: the "for...next" cycle.

Where?
How?

[Zizi64]

See the HELP of the StarBasic.

[Zizi64]

What do you want to do cyclically by your macro?

[Nemesis]

I need a new row every 8th row (7rows of text, one empty, 7rows of text, 1 empty)..
the text is already there..

[Lupp]

The document you are talking of surely is a spreadsheet document.
Such a document may have many sheets, and each sheet has 2^20 (1 048 576) logical rows. Inserting a new row after every 7th row previously existing would create 131 072 groups of rows per sheet (and push as many rows out of the sheet at the bottom). You cannot seriously expect this to be reasonable.

A design of a spreasheet needing to perform such an operation (once only or once in a while?) surely should be reconsidered.
You probably should tell us what you want to achieve based on your sheets finally.

HJow many columns are filled with the "text already there"?

[Zizi64]

You can enumerate the rows/columns of the used cell range:

viewtopic.php?f=21&t=96475

Then you will able to control the rows in the used range only.
It is better to insert rows started at the last row (backwards), because the inserted rows will modify the size of the used range...

[Lupp]

I wouldn't withdraw my comments concerning the kind of task and the sheet design.

However, if done at all the process should not run in the dark, but be triggered and observed interactively.
Specialized code might then roughly look like

Code: Select all

Sub insertRowsAfterEveryNth(Optional pN)
If IsMissing(pN) Then pN = 7
doc = ThisComponent
sel = doc.CurrentSelection
If NOT sel.supportsService("com.sun.star.sheet.SheetCellRange") Then Exit Sub
sheet = sel.Spreadsheet
c = sel.Rows.Count \ pN
ra = sel.getCellByPosition(0, 0).RangeAddress
With ra
  sr = .StartRow
  er = .StartRow + c * pN
  .StartColumn = 0
  .EndColumn = sheet.RangeAddress.EndColumn
  doc.UndoManager.enterUndoContext("Insert Rows every...")
  While er>sr
    .StartRow = er
    .EndRow = er
    sheet.insertCells(ra, 1)
    er = er - pN
  Wend
  doc.UndoManager.leaveUndoContext()
End With
End Sub

This is demonstrated in the attached example.

aoo104470insertRowsEveryNth.ods

(23.23 KiB) Downloaded 465 times