I'm trying build a excel based input form, I have found something online and I'm trying to understand these codes:
Dim Hsheet,Isheet As Worksheet
Dim NextRow, oCol As Long
Dim MyRng, MyCell As Range
Dim MyCopy, ClearCells As String
Set Hsheet = Worksheet("InputForm")
Set ISheet = Worksheet("Database")
This is the part I don't understand, can someone explain to me please?
With Hsheet
nextRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row
End With
With Isheet
Set myRng = .Range(MyCopy)
If Application.CountA(myRng) <> myRng.Cells.Count Then
MsgBox "Please fill in all the cells!"
Exit Sub
End If
End With
And also this part, can someone explain to me please?
With Hsheet
.Cells(nextRow, "a").Value = Application.UserName
oCol = 1
For Each myCell In MyRng.Cells
Hsheet.Cells(NextRow, oCol).Value = myCell.Value
oCol = oCol + 1
Next myCell
End With
Thanks in advance :)
With Isheet
On Error Resume Next
With .Range(ClearCells).Cells.SpecialCells(xlCellTypeConstants)
.ClearContents
Application.Goto .Cells(1) ', Scroll:=True
End With
On Error GoTo 0
End With
I can explain what the code does but there are few things which I would like to mention :)
A
Dim Hsheet,Isheet As Worksheet
Dim NextRow, oCol As Long
Dim MyRng, MyCell As Range
Dim MyCopy, ClearCells As String
This is not the right way to declare the variables/objects For example if you consider this line which is
Dim Hsheet,Isheet As Worksheet
Here, only Isheet has been declared as a worksheet and not Hsheet. The Hsheet automatically becomes a variant. The right way is
Dim Hsheet As Worksheet, Isheet As Worksheet
Dim NextRow As Long, oCol As Long
Dim MyRng As Range, MyCell As Range
Dim MyCopy As String, ClearCells As String
B
With Hsheet
nextRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row
End With
What this code does is it tries to find the last row which has data in Col A and then offsets one row down to get the next empty row so that you can write to it.
Another way to write the same thing is mentioned here So the above code can also be written as
With Hsheet
nextRow = .Range("A" & .Rows.Count).End(xlUp).Row + 1
End With
C
With Isheet
Set myRng = .Range(MyCopy)
If Application.CountA(myRng) <> myRng.Cells.Count Then
MsgBox "Please fill in all the cells!"
Exit Sub
End If
End With
I believe MyCopy is supposed to hold some value which I cannot see it in your code. Assuming that it holds a valid cell address, what the code is trying to do is to ensure that all cells are filled up by comparing the cells count vs the number of cells filled up.
D
With Hsheet
.Cells(NextRow, "a").Value = Application.UserName
oCol = 1
For Each myCell In MyRng.Cells
Hsheet.Cells(NextRow, oCol).Value = myCell.Value
oCol = oCol + 1
Next myCell
End With
This is also pretty straightforward. The code stores the UserName in the next available cell in Col A and then stores the values from Range MyRng in Sheet Isheet in Col A of Sheet Hsheet
HTH
Your piece of code seems to do some copy from one sheet to another, adding the user name on top of a range.
However the string variable MyCopy does not seem to be initialized, therefore I don't think running this macro as is would produce any desired result (unless the Range function returns some cells when called with an empty string ? I don't know its specs).
I don't remember Excel VBA perfectly, but I think that :
Cells(.Rows.Count, "A") selects the cell located on the last row, column "A".
End(xlUp) moves the selection to the top of the range of contiguous non-empty cells (like pressing CTRL + UP in Excel, I think).
Offset(1, 0) moves the selection to one cell to the bottom.
Row returns that cell's row number.
So your first code block sets the row number of the second row of the last range of non-empty cells in column A, to the variable nextRow .
You can follow the same reasoning to understand the purpose of all the other code blocks. I suggest your search MSDN's VBA for Excel documentation websites to get more information about the meaning of each function you don't understand yet.
Related
I have a sheet in libreoffice Calc which has an Id Column with incremental value from 1 to N.
I need to create a Macro in VBA (linked to a button i will create later) where i can select the last ID (which is the MAX id also) and delete the entire row relating to this ID.
i tried this so far
Sub suppression
dim maxId as Integer
my_range = ThisComponent.Sheets(0).getCellRangebyName("B19:B1048576")
maxId = Application.WorksheetFunction.Max(range("Dépôts!B19:B1048576"))
MsgBox maxId
End Sub
Thanks a lot for your help.
In libreoffice BASIC you first need to get the data array of the cell range. This is an array of arrays each representing a row of the cell range. It is indexed from zero irrespective of the location of the cell range within the sheet. Because your cell range is one column wide, each member array has only one member, which is at index zero.
As Jim K says, 'Application.WorksheetFunction' is from VBA. It is possible to use worksheet functions in LibreOffice BASIC, but these act on ordinary arrays rather than cell arrays, and the MAX function takes a one-dimensional array so it would be necessary to first reshape the data array using a loop. Furthermore, if you want to delete the row corresponding to the maximum value you are then faced with the problem of finding the index of that row using only the value itself.
It is much simpler to find the index by looping over the data array as shown in the snippet below.
Also, rather than traversing over a million rows, it would save computational effort to obtain the last used row of the spreadsheet via the BASIC function 'GetLastUsedRow(oSheet as Object)', which is supplied with LibreOffice. This is located in the 'Tools' library in 'LibreOffice Macros & Dialogs'. To use it you have to put the statement: 'Globalscope.BasicLibraries.LoadLibrary("Tools")' somewhere before you call the function.
To delete the identified row, get the XTableRows interface of the spreadsheet and call its removeByIndex() function.
The following snippet assumes that the header row of your table is in row 18 of the sheet, as suggested by your example code, which is in row 17 when numbered from zero.
Sub suppression()
' Specify the position of the index range
''''''''''''''''''''''''''''''''''''
Dim nIndexColumn As Long '
nIndexColumn = 1 '
'
Dim nHeaderRow As Long '
nHeaderRow = 17 '
'
''''''''''''''''''''''''''''''''''''
Dim oSheet as Object
oSheet = ThisComponent.getSheets().getByIndex(0)
' Instead of .getCellRangebyName("B19:B1048576") use:
Globalscope.BasicLibraries.LoadLibrary("Tools")
Dim nLastUsedRow As Long
nLastUsedRow = GetLastUsedRow(oSheet)
Dim oCellRange As Object
' Left Top Right Bottom
oCellRange = oSheet.getCellRangeByPosition(nIndexColumn, nHeaderRow, nIndexColumn, nLastUsedRow)
' getDataArray() returns an array of arrays, each repressenting a row.
' It is indexed from zero, irrespective of where oCellRange is located
' in the sheet
Dim data() as Variant
data = oCellRange.getDataArray()
Dim max as Double
max = data(1)(0)
' First ID number is in row 1 (row 0 contains the header).
Dim rowOfMaxInArray As Long
rowOfMaxInArray = 1
Dim i As Long, x As Double
For i = 2 To UBound(data)
x = data(i)(0)
If x > max Then
max = x
rowOfMaxInArray = i
End If
Next i
' if nHeaderRow = 0, i.e. the first row in the sheet, you could save a
' couple of lines by leaving the next statement out
Dim rowOfMaxInSheet As long
rowOfMaxInSheet = rowOfMaxInArray + nHeaderRow
oSheet.getRows().removeByIndex(rowOfMaxInSheet, 1)
End Sub
This Macro is used to cut, insert and delete a cell range section of a workbook.
The problem I was trying to solve and gave up with the lack of response in another thread is why copying multiple non-adjacent rows to the MS clipboard often loses their row line-breaks when pasting.
E.g. Since trying to paste 3 non-adjacent rows into row 10, 11 and 12, often puts all 3 rows into row 10 with one row in fields A10-P10, the next row in Q10-AF10 and the last row into AG10-AV10...
I edited the Macro below to fix this mistake when this happens.
So, for example, I can now highlight row 10 and run the macro to cut/insert the fields Q10-AF10 to A11-P11 and delete/shift left the blank fields now in Q10-AF10.
I'm hoping for help to loop this process until there's no data outside Column A-P. In this case, no data outside cell P10.
Sub FixAllOnLine1OneRowAtATimeInsertToNextRow()
Application.ScreenUpdating = False
Dim copySheet As Worksheet
Dim pasteSheet As Worksheet
Set copySheet = ActiveSheet
Set pasteSheet = ActiveSheet
copySheet.Range("Q" & ActiveCell.Row & ":AF" & ActiveCell.Row).Copy
Range("Q" & ActiveCell.Row & ":AF" & ActiveCell.Row).Offset(1).Select
pasteSheet.Cells(ActiveCell.Row, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Application.CutCopyMode = False
Application.ScreenUpdating = True
Columns("Q:AF").Select
Selection.Delete Shift:=xlToLeft
End Sub
Ok, I made some headway. I just have one super easy issue and then I need to loop it.
The first issue is that it cuts Column Q:AF correct of the row I've highlighted and shifts the entire Column Q:AF to the left, but it INSERTS the cut cells into the fixed range, A2:P2. I want to INSERT the cut cells down ONE row from my selection. I KNOW this is a couple characters in the Offset, I just can't get it.
Then, once it's working properly...say I highlight row 10, it cuts Q10:AF10 and instead INSERTS the cells into A11:P11 and shifts "Q:AF" to the left, then I need to figure out how to get it to loop until there's no more data to right of Column P. When this problem occurs pasting multiple rows from the clipboard all into the first row losing the row line-breaks, it's always quite a few rows.
Any ideas?
Thanks so much!
Mark
Sub FixAllOnLine1OneRowAtATimeInsertToNextRow()
Dim ws As Worksheet
Dim lNextRow As Long
Application.ScreenUpdating = False
Set ws = ActiveSheet
ws.Range("Q" & ActiveCell.Row & ":AF" & ActiveCell.Row).Copy 'Copy the row of the selected cell from Q:AF
ws.Range("Q" & ActiveCell.Row & ":AF" & ActiveCell.Row).Offset(1).Select 'Select the cells you have just copied. Not needed
ws.Cells(ActiveCell.Row, 1).End(xlUp).Offset(1, 0).Insert xlShiftDown ' Paste the copied values in to column "A" on next row?
'lNextRow = ws.Range("A" & Rows.count).End(xlUp).Row + 1 'Get Next Row number
'Range("A" & lNextRow).PasteSpecial xlPasteValues
Application.CutCopyMode = False
Range("Q:AF").Delete Shift:=xlToLeft
'Columns("Q:AF").Select
'Selection.Delete Shift:=xlToLeft
Application.ScreenUpdating = True
ActiveCell.Offset(RowOffset:=-1, columnOffset:=0).Activate 'Added to move active cell up one row to run it again for multiple groups to apply fix.
End Sub
Here's a solution in another direction just in case someone from the engines needs it...
Sub ReduceNoOfColumns()
Dim iRow As Integer 'Row to be manipulated
Dim iRowToPasteTo 'Row number to paste the copied cells
Dim iCurCol As Integer 'Current Column number of first cell with a value to cut
Dim NoOfCols As Integer 'integer to hold max number of columns
Dim sAddress As String
iRow = ActiveCell.Row
iRowToPasteTo = iRow + 1
NoOfCols = 16 'Set this number to the total number of columns you wish to have (in your case 16)
iCurCol = NoOfCols + 1
Do Until Cells(iRow, iCurCol).Value = "" 'Keep looping until we get to an empty column
sAddress = ColNoToLetter(iCurCol) & iRow & ":" & ColNoToLetter(iCurCol + NoOfCols - 1) & iRow
Rows(iRowToPasteTo & ":" & iRowToPasteTo).Insert Shift:=xlDown
Range(sAddress).Copy
Range("A" & iRowToPasteTo).PasteSpecial xlPasteAll
Range(sAddress).Clear
iCurCol = iCurCol + NoOfCols
iRowToPasteTo = iRowToPasteTo + 1
Loop
End Sub
Function ColNoToLetter(iCol As Integer) As String
Dim vArr
vArr = Split(Cells(1, iCol).Address(True, False), "$")
ColNoToLetter = vArr(0)
End Function
I currently have an Excel 2010 spreadsheet. I have designed a form and I'm looking to allow users to enter date into the form and it then be entered into the worksheet.
My first entry is "txtDate" on my form and I wish for this to be entered into cell J7 with the next data in the form "txtTime" going into cell K7 and then other data into other cells in the row - L7, M7, N7 etc etc... Once this cell is submitted with a button using on the form, the data is entered and then the next time the form is used, the data will go into the next row below, row 8 and then row 9 on the next occasion etc...
I've found the sample below code on the internet and the example shows that it starts in cell A2. I can't see mention of A2 and so I'm wondering how I edit the code to start in cell J7.
'Copy input values to sheet.
Dim lRow As Long
Dim ws As Worksheet
Set ws = Worksheets("Animals")
lRow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
With ws
.Cells(lRow, 1).Value = Me.cboClass.Value
.Cells(lRow, 2).Value = Me.txtGivenName.Value
.Cells(lRow, 3).Value = Me.txtTagNumber.Value
.Cells(lRow, 4).Value = Me.txtSpecies.Value
.Cells(lRow, 5).Value = Me.cboSex.Value
.Cells(lRow, 6).Value = Me.cboConservationStatus.Value
.Cells(lRow, 7).Value = Me.txtComment.Value
Here is my code dated 27/03/2015 following the answer:
Dim lRow As Long
Dim ws As Worksheet
Set ws = Worksheets("Pursue")
lRow = Application.WorksheetFunction.Max(ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row, 7)
With ws
.Cells(lRow, 10).Value = Me.dateBox.Value
etc....
.Cells(lRow, 1).Value (and so forth) is what references what cell is written to. The first argument says what row the cell is in, the second what column it is in. When referencing the cells explicitly I see little reason to do it this way though, it is mainly for when you'd make a loop where e.g. lRow was incremented by one for each iteration in order to write down a column.
Since lRow is decided using lRow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row it will always be the number of the first empty row in column A. To change it to return the first empty row in column J, you need to change the 1 in Cells to 10 (J is the 10th letter in the alphabet. To get it to not start further up than row 7 at any time, I'd add in a Max-statement:
lRow = Application.WorksheetFunction.Max(ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row, 7)
To get the sub to write to column J onwards inside the With-statement, you need to change the column-references to reflect this. Currently it writes to column 1, 2, 3, etc. you want it to write to column 10, 11, 12, etc. I.e. something like:
With ws
.Cells(lRow, 10).Value = Me.cboClass.Value
.Cells(lRow, 11).Value = Me.txtGivenName.Value
.Cells(lRow, 12).Value = Me.txtTagNumber.Value
etc.
I would like to add a [set of] standardized macro[s] to some of the cells of a custom spredsheet (Open/Libre/Star Office).
Said macro should be activated using a Form PushButton dropped into the relevant cell[s].
I experience several problems all relative to the access of the "relevant cell":
If I try to Anchor to Cell a PushButton it goes to A1 and not to currently selected cell.
I can connect a Basic fragment to the button, but I found no way to retrieve the "relevent cell" (i.e.: the cell containing the button).
What I am trying to do (as a first working example) is to add a button to increment the numeric value of the cell (possibly disabling direct editing; I want that value to go up by one at each button press and no way to otherwise change cell).
Is such a thing possible at all?
Any example (or pointer to docs) very welcome.
NOTE: This question gives some hints on how to solve problem in VBA (Excel), but I found nothing for [L|O|S]Office
You can find the cell containing the button from a handler as follows:
Sub ButtonHandler(oEvent)
Dim sControlName$
Dim oSheet
Dim nCount As Long
Dim i As Long
Dim oPage
Dim oShape
Dim oAnchor
sControlName = oEvent.source.model.Name
oSheet = thiscomponent.currentcontroller.activesheet
nCount = oSheet.drawpage.count
oPage = oSheet.drawpage
For i = 0 To nCount - 1
oShape = oPage.getbyindex(i)
'oControlShape = oPage.getbyindex(i).control
If (oShape.supportsService("com.sun.star.drawing.ControlShape")) Then
If oShape.control.Name = sControlName Then
oAnchor = oShape.anchor
If (oAnchor.supportsService("com.sun.star.sheet.SheetCell")) Then
Print "Button is anchored in cell: " + oAnchor.AbsoluteName
Exit For
End If
End If
End If
Next i
End Sub
I know, it is not pretty is it? I added significant error checking.If you then want to know what cell was active when you clicked the button, you can call this routine
Sub RetrieveTheActiveCell()
Dim oOldSelection 'The original selection of cell ranges
Dim oRanges 'A blank range created by the document
Dim oActiveCell 'The current active cell
Dim oConv 'The cell address conversion service
Dim oDoc
oDoc = ThisComponent
REM store the current selection
oOldSelection = oDoc.CurrentSelection
REM Create an empty SheetCellRanges service and then select it.
REM This leaves ONLY the active cell selected.
oRanges = oDoc.createInstance("com.sun.star.sheet.SheetCellRanges")
oDoc.CurrentController.Select(oRanges)
REM Get the active cell!
oActiveCell = oDoc.CurrentSelection
oConv = oDoc.createInstance("com.sun.star.table.CellAddressConversion")
oConv.Address = oActiveCell.getCellAddress
Print oConv.UserInterfaceRepresentation
print oConv.PersistentRepresentation
REM Restore the old selection, but lose the previously active cell
oDoc.CurrentController.Select(oOldSelection)
End Sub
I've been searching a lot but could find little to no info about LibreOffice Basic
I'm a bit used to programming macros in excel but this time a need to do a loop until i reach the first empty column and it needs to be in libreoffice.
In excel i would do something like this:
Dim i As integer
i = 0
Range("A1").Select
While cell.Offset(0, i).Value <> Null
i = i + 1
Wend
MsgBox ("First empty column is " & Chr(i + 64))
But in libreoffice i have no idea.
Can anyone help me.
Thanks,
Bruno
I managed to find the answer this way:
dim cell as object
dim i as integer
i = 0
cell = Sheet.getCellByPosition(i,0)
while Cell.Type <> com.sun.star.table.CellContentType.EMPTY
i = i+1
cell = Sheet.getCellByPosition(i,0)
wend
When the loop ends I get the variable i which corresponds to the column number. I can then convert it to the letter the same way as in excel (chr functions)
rem I had a similar problem to solve.
rem Update for libreoffice 7.
rem Replaced "sheet" with "ThisComponent.Sheets(0)".
rem Thanks.
sub main
dim cell as object
dim i as integer
i = 0
rem "sheet" alone does not run
cell = ThisComponent.Sheets(0).getCellByPosition(i,0)
while Cell.Type <> com.sun.star.table.CellContentType.EMPTY
i = i+1
cell = ThisComponent.Sheets(0).getCellByPosition(i,0)
wend
MsgBox( i )
end sub