Ask Your Question
0

Cut/Paste loop macro problem [closed]

asked 2013-03-22 23:49:37 +0100

Brokenstorm gravatar image

updated 2015-10-27 12:49:28 +0100

Alex Kemp gravatar image

I'm trying to create a macro that cuts groups of 8 cells and does a paste special with a transpose. The problem I'm having is that sometime the macro will skip pasting a group. The group that are skipped are also different each time the macro is run.

The problem only seems to occur with large (50+) iteration count.

Here is my loop:

args2(0).Name = "Flags"
args2(0).Value = "A"
args2(1).Name = "FormulaCommand"
args2(1).Value = 0
args2(2).Name = "SkipEmptyCells"
args2(2).Value = false
args2(3).Name = "Transpose"
args2(3).Value = true
args2(4).Name = "AsLink"
args2(4).Value = false
args2(5).Name = "MoveMode"
args2(5).Value = 4


for i = 1 to Iteration step 1   
    args1(0).Name = "ToPoint"
    args1(0).Value = "A" + (8*i-7) + ":A" + (8*i)

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


    args1(0).Name = "ToPoint"
    args1(0).Value = "B" + i

    dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args1())
    dispatcher.executeDispatch(document, ".uno:InsertContents", "", 0, args2())
next i

So far the only solution I have found is running the macro multiple times until all the group have been transposed at least once.

edit retag flag offensive reopen merge delete

Closed for the following reason the question is answered, right answer was accepted by Alex Kemp
close date 2015-10-27 12:49:40.409419

1 Answer

Sort by » oldest newest most voted
1

answered 2013-03-24 20:58:16 +0100

JohnSUN gravatar image

Try deselect previous selection before next .uno:GoToCell

...
    args1(0).Value = "A" + (8*i-7) + ":A" + (8*i)
    dispatcher.executeDispatch(document, ".uno:GoToStart", "", 0, Array())
    dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args1())
    dispatcher.executeDispatch(document, ".uno:Copy", "", 0, Array())
...

Or try rewrite macro without DispatchHelper

Sub Transpose8(Optional oActiveSheet As Variant)
Dim oCursor As Variant
Dim aRangeAddress As New com.sun.star.table.CellRangeAddress
Dim nEndRow As Long
Dim nCountResultRows As Long
Dim i As Long, j As Long
Dim oCellRange As Variant
Dim oDataArray As Variant
Dim outDataArray As Variant
    If IsMissing(oActiveSheet) Then
        oActiveSheet = ThisComponent.getCurrentController().getActiveSheet()
    EndIf

    oCursor = oActiveSheet.createCursor()
    oCursor.gotoEndOfUsedArea(True)
    aRangeAddress = oCursor.getRangeAddress()
    nEndRow = aRangeAddress.EndRow

    nCountResultRows =  Int((nEndRow+7) / 8)
    nEndRow = nCountResultRows*8-1

    oCellRange = oActiveSheet.getCellRangeByPosition(0, 0, 0, nEndRow)
    oDataArray = oCellRange.getDataArray()
    outDataArray = DimArray(nCountResultRows-1)
    j = 0
    For i = 0 To nEndRow-1 Step 8
        outDataArray(j) = Array(oDataArray(i)(0), _
                                oDataArray(i+1)(0), _
                                oDataArray(i+2)(0), _
                                oDataArray(i+3)(0), _
                                oDataArray(i+4)(0), _
                                oDataArray(i+5)(0), _
                                oDataArray(i+6)(0), _
                                oDataArray(i+7)(0))
        j = j + 1
    Next i
    oCellRange = oActiveSheet.getCellRangeByPosition(1, 0, 8, nCountResultRows-1)
    oCellRange.setDataArray(outDataArray)
End Sub

Or use formula

=OFFSET($A$1;(ROW()-1)*8+MOD(COLUMN()-2;8);0)

and solve a task without a macro

Without macro

edit flag offensive delete link more

Question Tools

Stats

Asked: 2013-03-22 23:49:37 +0100

Seen: 2,773 times

Last updated: Mar 24 '13