Basic macro code for inserting row in calc spreadsheet

[Haagen]

Hi.

I wonder if you can help me convert this Visual Basic code (Excel) into Basic so I can use the macro in LibreOffice Calc.

The VB code is as follows:

Option Explicit

Sub RowInsert()

Dim RwNo As Long

Dim Rw2In As Long

Application.ScreenUpdating = False

RwNo = InputBox("Row # below which to insert rows.", "Cell Name")

Rw2In = InputBox("No. of rows to insert.", "Rows")

Range("A" & RwNo + 1).Resize(Rw2In).EntireRow.Insert

'Range("F" & RwNo), Range("G" & RwNo), Range("H" & RwNo), Range("I" & RwNo), Range("0" & RwNo))).Copy

ActiveSheet.Range("B" & RwNo & ":B" & RwNo + Rw2In).Select
Selection.FillDown

ActiveSheet.Range("C" & RwNo & ":C" & RwNo + Rw2In).Select
Selection.FillDown

ActiveSheet.Range("J" & RwNo & ":J" & RwNo + Rw2In).Select
Selection.FillDown

ActiveSheet.Range("K" & RwNo & ":K" & RwNo + Rw2In).Select
Selection.FillDown

ActiveSheet.Range("L" & RwNo & ":L" & RwNo + Rw2In).Select
Selection.FillDown

ActiveSheet.Range("N" & RwNo & ":N" & RwNo + Rw2In).Select
Selection.FillDown

Application.CutCopyMode = False

Range("A" & RwNo).Select

Application.ScreenUpdating = True

End Sub

The macro is meant to be run in sheets where it is only possible to enter data in cells that are unlocked.

In order to avoid having to unprotect the sheet every time I want to insert a row between existing rows, I have this code that opens a dialogue box to eneter row no. and no. of rows to insert under the specified row no. A Keystroke combination is associated with the macro.

Thank you for your help.

Haagen

[Przemo]

I think it would be easier if you ask for a macro that inserts number of given rows in a given place and executes pull-down on the inserted cells. Then you can adapt it to you specific needs - use it on columns B,C,J,K,L,N. Did you try it yourself? There are plenty examples on the net.

[newbie-02]

you can find calc code to do things by ‘recording’ a similar action, it produces cruel code with ‘dispatcher callc’ or the like, but is the! ‘kiss’ way to get something up and running,

[Zizi64]

Try the option VBA support for the original code:

Option Explicit
Option VBASupport 1

[tkdchen]

This is not a direct translation from your VB code, but hopefully it is useful for you.

Function InsertNewRowInUsedArea(ByVal oSheet As Object, _
								Optional ByVal anFillInColumns() As Integer) As Integer
	Dim oCursor As Object, intUsedRowsCount As Integer
	oCursor = oSheet.createCursor()
	oCursor.gotoEndOfUsedArea(True)
	intUsedRowsCount = oCursor.Rows.count
	oSheet.Rows.insertByIndex(intUsedRowsCount, 1)
	InsertNewRowInUsedArea = intUsedRowsCount

	Dim nNewRow As Integer
	nNewRow = intUsedRowsCount

	Dim nIndex As Integer
	For nIndex = 0 To UBound(anFillInColumns)
		FillCellsInRow oSheet, anFillInColumns(nIndex), nNewRow
	Next
End Function

sub FillCellsInRow(	ByVal objSheet As Object, _
					ByVal intFromCol As Integer, _
					ByVal intFillInRow as Integer, _
					Optional ByVal intToCol As Integer)
	Dim objRange as Object, intRightCol as Integer
	If IsMissing(intToCol) then
		intRightCol = intFromCol
	Else
		intRightCol = intToCol
	end if
	objRange = objSheet.getCellRangeByPosition(intFromCol, intFillInRow - 1, intRightCol, intFillInRow)
	objRange.fillAuto(com.sun.star.sheet.FillDirection.TO_BOTTOM, 1)
End sub