I'm trying to insert a cell beginning with the first cell in a range (via the .getCellRangeByName() method of a Document's active Sheet).
I found out how to do this with a Dispatcher from the OpenOffice library (.uno:InsertCell), but I'd prefer to use something that doesn't require the dispatcher if possible.
Example code that I plan to wire-up to a button...
Sub AddManualBalance(EntryDate As Date, EntryAmount As Currency)
Dim Doc As Object
Dim Sheet As Object
Doc = ThisComponent
If Doc Is Nothing Then
Return
EndIf
Sheet = Doc.getCurrentController().getActiveSheet()
If Sheet Is Nothing Then
Return
EndIf
Dim TargetCells As Object
TargetCells = Sheet.getCellRangeByName("B9:C9");
// insert a cell in both the B and C columns at position 9,
// then move all other cells down
// add my EntryDate as a value to the new cell in B column
// add my EntryAmount as a value to the new cell in C column
End Sub
Thanks in advance for any help!
P.S. I really dislike Basic, but it seems that with spreadsheets and office app automation, that's the preferred language. Is there any way to do LibreOffice/OpenOffice macros in a more C-like language?
Following code does what you want:
Dim Doc As Object
Dim Sheet As Object
Dim oDestCell As Object
Dim CellRangeAddress As New com.sun.star.table.CellRangeAddress
Doc = ThisComponent
Sheet = Doc.Sheets(0)
CellRangeAddress.Sheet = 0
CellRangeAddress.StartColumn = 1
CellRangeAddress.StartRow = 8
CellRangeAddress.EndColumn = 2
CellRangeAddress.EndRow = 8
Sheet.insertCells(CellRangeAddress, com.sun.star.sheet.CellInsertMode.DOWN)
oDestCell=Sheet.getCellByPosition(1,8)
oDestCell.setValue(EntryDate)
oDestCell=Sheet.getCellByPosition(2,8)
oDestCell.setValue(EntryAmount)
You can read about C++ and LibreOffice at api.libreoffice.org
Thanks to Mac, my code is now...
Public Doc As Object
Public Sheet As Object
Sub AddManualBalance()
GetCurrentSheet()
REM insert two new cells, move cells down
Dim TargetCells As New com.sun.star.table.CellRangeAddress
TargetCells.Sheet = 3
TargetCells.StartColumn = 1
TargetCells.StartRow = 8
TargetCells.EndColumn = 2
TargetCells.EndRow = 8
Sheet.insertCells(TargetCells, com.sun.star.sheet.CellInsertMode.DOWN)
REM get date and balance from text boxes, add value to cells
Dim BalanceDate As Object
Dim BalanceAmount As Object
Dim Forms As Object
Dim MainForm As Object
Forms = Doc.getCurrentController().getActiveSheet().getDrawPage().getForms()
MainForm = Forms("MainForm")
BalanceDate = MainForm.getByName("BalanceDate")
BalanceAmount = MainForm.getByName("BalanceAmount")
Sheet.getCellByPosition(1,8).setValue(BalanceDate.CurrentValue)
Sheet.getCellByPosition(2,8).setValue(BalanceAmount.CurrentValue)
End Sub
Sub GetCurrentSheet()
REM get references to document and active sheet, test if exist
If ThisComponent Is Nothing Then
Return
End If
Doc = ThisComponent
If Doc Is Nothing Then
Return
EndIf
Sheet = Doc.getCurrentController().getActiveSheet()
End Sub
Related
My program has output data to the Listview control. Now I would like to export the data to a text file/excel and then load it back to the listview control when I need to. I know how to do both these tasks using the listbox control but listview is new to me. I've been researching and playing around with code for hours but I keep getting one error or the other. Kindly find the latest version of my code to export data below. Also, if you could provide code to import, that would be super.
'Export the listview to an Excel spreadsheet
Dim SaveFileDialog1 As New SaveFileDialog
SaveFileDialog1.Title = "Save Excel File"
SaveFileDialog1.Filter = "Excel files (*.xls)|*.xls|Excel Files
(*.xlsx)|*.xslx"
SaveFileDialog1.ShowDialog()
'exit if no file selected
If SaveFileDialog1.FileName = "" Then
Exit Sub
End If
'create objects to interface to Excel
Dim xls As New Excel.Application
Dim book As Excel.Workbook
Dim sheet As Excel.Worksheet
Dim placeholder As String
'create a workbook and get reference to first worksheet
xls.Workbooks.Add()
book = xls.ActiveWorkbook
sheet = book.ActiveSheet
'step through rows and columns and copy data to worksheet
Dim row As Integer = 1
Dim col As Integer = 1
For Each item As ListViewItem In lstViewUsers.Items
For i As Integer = 0 To item.SubItems.Count - 1
placeholder = sheet.Cells(row, col) = item.SubItems(i).Text
col = col + 1
Next
row += 1
I have a problem with my below code which freezes and does nothing while running.
INFRASTRUCTURE:
Visual Studio 2017
.NET Framework 4.7.2
OS: Windows 7
GOAL:
I have a DataGridView which has 3 columns, I'm listing some information in this DataGridView from another source to fill first and second row.
The first row is the parameter name and the second one is this parameter's current value.
The third column is not filling in this process, I will fill that 3rd column from my database Excel file to compare the parameter's current value with the database value stored in Excel. This is where my problems start.
I'm trying to use below code for filling DataGridView parameter value from Excel sheet which I'm using a database;
Some parameters not stored in an Excel sheet so in fact, I need a function like vlookup to map data with the parameter name.
In excel A column is my parameter name and B column is the parameter's database value.
I'm trying to import this excel and trying to match parameter names in DataGridView and Excel if the parameter name is same it should writing Excel parameter value to a 3rd column in DataGridView.
Public Class BuildImportExcel
Public Shared Sub NewMethod(ByVal dgv As DataGridView)
Dim ofd As OpenFileDialog = New OpenFileDialog With {
.Filter = "Excel |*.xlsx",
.Title = "Import Excel File"
}
ofd.ShowDialog()
Try
If ofd.FileName IsNot "" Then
Dim xlApp As New Excel.Application
If xlApp Is Nothing Then
MessageBox.Show("Excel is not properly installed!")
Else
Dim xlBook As Excel.Workbook = xlApp.Workbooks.Open(ofd.FileName)
Dim xlSheet As Excel.Worksheet = CType(xlBook.ActiveSheet, Excel.Worksheet)
For i = 0 To dgv.Rows.Count
If dgv.Rows(i).Cells(0).Value IsNot "" Then
Dim look As Boolean = True
Dim found As Boolean = False
Dim rowLook As Integer = 2
Dim rowFound As Integer = 0
While look = True
If xlSheet.Range("A" & rowLook).Value IsNot "" Then
If xlSheet.Range("A" & rowLook).Text Is dgv.Rows(i).Cells(0).Value Then
found = True
rowFound = rowLook
End If
Else
look = False
End If
rowLook = rowLook + 1
End While
If found = True Then
dgv.Rows(i).Cells(2).Value = xlSheet.Range("B" & rowFound).Text
End If
End If
Next
xlApp.Quit()
Release(xlSheet)
Release(xlBook)
Release(xlApp)
End If
End If
Catch ex As Exception
MsgBox(ex.Message)
End Try
End Sub
Private Shared Sub Release(ByVal sender As Object)
Try
If sender IsNot Nothing Then
Marshal.ReleaseComObject(sender)
sender = Nothing
End If
Catch ex As Exception
sender = Nothing
End Try
End Sub
End Class
But the problem is it's not working freezing I thought parameter list about 200 rows so it causes to freezing and try it with small portions like 5 parameters and still same. Seems something wrong and I couldn't find it.
Also is it logic way to match them with that method or do you suggest anything like OLEDB connection?
EDIT:
I turn off Option Strict and then change IsNot to operator <> and then it start to work but i'd like to use Option Strict On how can i handle this operators?
You are making this more difficult than it has to be. A questionable and problematic area is the While look = True loop. This assumes a lot and, in my test, will cause the code to freeze often. The main problem here is that the code is (somewhat) looping through the rows from the Excel file. The issue here is that you do not KNOW how may rows there are! There is no checking for this and the code will fail on the line…
If xlSheet.Range("A" & rowLook).Value IsNot "" Then
When you reach the bottom of the given Excel file and it never finds a match.
Another issue is the line…
If xlSheet.Range("A" & rowLook).Text Is dgv.Rows(i).Cells(0).Value Then
This is ALWAYS going to fail and will never be true. My understanding…
The Is operator determines if two object references refer to the same
object. However, it does not perform value comparisons.
Given this, I recommend you simplify things a bit. Most important are the loops through the Excel worksheet which is “expensive” and if there is a lot of rows, you may have a performance problem. When I say a lot of rows, I mean tens of thousands of rows…. 200 rows should be fine.
It would un-complicate things if we could tell how many rows from the worksheet are returned from….
Dim xlSheet As Excel.Worksheet = CType(xlBook.ActiveSheet, Excel.Worksheet)
This is basically an Excel Range, and it is from this Range that we can get the number of rows in this excel range with…
Dim totalExcelRows = xlSheet.UsedRange.Rows.Count
Now, instead of the complicated and problematic While loop, we can replace it with a simple for loop. This will eliminate some variables and will keep the loop index in row range in the excel file.
I hope this makes sense… below is an example of what is described above.
Public Shared Sub NewMethod(ByVal dgv As DataGridView)
Dim ofd As OpenFileDialog = New OpenFileDialog With {
.Filter = "Excel |*.xlsx",
.Title = "Import Excel File",
.InitialDirectory = "D:\\Test\\ExcelFiles"
}
ofd.ShowDialog()
Try
If ofd.FileName IsNot "" Then
Dim xlApp As New Excel.Application
If xlApp Is Nothing Then
MessageBox.Show("Excel is not properly installed!")
Else
Dim xlBook As Excel.Workbook = xlApp.Workbooks.Open(ofd.FileName)
Dim xlSheet As Excel.Worksheet = CType(xlBook.ActiveSheet, Excel.Worksheet)
Dim totalExcelRows = xlSheet.UsedRange.Rows.Count
For i = 0 To dgv.Rows.Count
If dgv.Rows(i).Cells(0).Value IsNot Nothing Then
For excelRow = 1 To totalExcelRows
If xlSheet.Range("A" & excelRow).Text.ToString() = dgv.Rows(i).Cells(0).Value.ToString() Then
dgv.Rows(i).Cells(2).Value = xlSheet.Range("B" & excelRow).Text
Exit For
End If
Next
Else
Exit For
End If
Next
xlApp.Quit()
Marshal.ReleaseComObject(xlSheet)
Marshal.ReleaseComObject(xlBook)
Marshal.ReleaseComObject(xlApp)
End If
End If
Catch ex As Exception
MsgBox(ex.Message)
End Try
End Sub
So, I'm a beginner when it comes to VBA, but I'm trying to create a simple way to send a reminder message to a bunch of people whose information is found on an excel spreadsheet. It is supposed to loop, sending emails to addresses found in the column until there is an empty cell.
I keep getting the error Object does not support this property or method on the line that begins with a *. I have spent the last hour trying to figure out why this error is appearing because Workbooks have the property Sheets which have Cells which return a value.
Sub Send_Reminder_Email()
Dim objMsg As MailItem
Set objMsg = Application.CreateItem(olMailItem)
Dim xlApp As Object, wb As Object
Dim row As Integer
Set xlApp = CreateObject("Excel.Application")
Set wb = xlApp.Workbooks.Open("C:\User\Me\...file.xls")
row = 2
*Do While Not IsEmpty(wb.Sheets.Cells(row, 2).Value)
objMsg.To = wb.Sheets.Cells(row, 6)
objMsg.BCC = "potapeno#foo.net"
objMsg.Subject = "Email"
objMsg.Body = "Information"
objMsg.Send
row = row + 1
Loop
Set objMsg = Nothing
Set wb = Nothing
Set xlApp = Nothing
row = 0
End Sub
I have also tried "activating" the workbook, but it fails to solve my problem. I can't figure out what object doesn't support what method.
wb.Sheets is a collection and doesn't have .Cells property. You can explore methods and properties with Object Browser pressing F2 in VBA Project. Enter class name and press Search button:
To get a certain Worksheet object you have to specify the item of the worksheets collection e. g. by worksheet name:
Do While Not IsEmpty(wb.Sheets.Item("Sheets1").Cells(row, 2).Value)
It may be not quite obvious that .Item() is a default property, but so it is, thus you can call it in reduced form:
Do While Not IsEmpty(wb.Sheets("Sheets1").Cells(row, 2).Value)
Or by worksheet index:
Do While Not IsEmpty(wb.Sheets(1).Cells(row, 2).Value)
I am trying to develop a function in VBA that returns the result to the current worksheet. It is intended that the function opens up another spreadsheet, extracts some data, does some processing and returns a value to the worksheet that called the function.
Everything works well when I call the function from the "immediate" window in the VBA editor. However, when I transfer the call to a worksheet the function behavior deviates from the expected when an attempt is made to open the other workbook (AreaBook). The object, AreaBook, remains as a pointer to nothing.
I've tried hard coding the filename; again a call to the function works from the immediate window but not when called from a workbook.
Any ideas?
Public Function pointInWhichArea(FileName As String, SheetName As String, areaID As String, ByVal pointLong As Single, ByVal pointLat As Single) As Variant ', testPointLon As Single, testPointLat As Single) As Variant
Dim a, b, c As Integer
Dim colAreaID, colLat, colLon As Integer
Dim AreaBook As Workbook
Dim AreaSheet As Worksheet
Dim polygonPoints() As pointType
Dim testPoint As pointType
Dim found As Boolean
' extract the point details
testPoint.x = pointLong
testPoint.y = pointLat
' set the workbook and sheet objects
FileName = filePath + FileName ' open the Area definition file
Set AreaBook = Workbooks.Open(FileName) ' <<<< PROBLEM HERE
Set AreaSheet = AreaBook.Sheets(SheetName)
a = 1 ' identify the Polygon ID, latitude and longitude columns column
While AreaSheet.Cells(1, a).Value <> ""
Select Case Worksheets(SheetName).Cells(1, a).Value
Case Is = areaID
colAreaID = a
Case Is = "Latitude"
colLat = a
Case Is = "Longitude"
colLon = a
End Select
a = a + 1
Wend
a = 2 ' loop through all points in the area list
b = a ' remember the beginning of the polygon
found = False
While (AreaSheet.Cells(a, colAreaID).Value <> "" And found = False)
If AreaSheet.Cells(a, colAreaID).Value <> AreaSheet.Cells(a + 1, colAreaID).Value Then ' test for the end of this polygon
c = a ' remember the end of the polygon
ReDim polygonPoints(b To c) As pointType ' array to capture the poylgon
For a = b To c ' loop through each point
polygonPoints(a).x = AreaSheet.Cells(a, colLon).Value ' extract the longitude of the point
polygonPoints(a).y = AreaSheet.Cells(a, colLat).Value ' extract the latitude of the point
Next a
b = a ' remember the beginning of the next polygon
If pointInArea(testPoint, polygonPoints) = True Then ' test if the point is in the current polygon
pointInWhichArea = AreaSheet.Cells(a - 1, colAreaID).Value ' return the area label
found = True
End If
Else
a = a + 1
End If
Wend
AreaBook.Close
End Function
I'm afraid a worksheet function cannot be used to affect other cells or workbooks - you can't add a function to cell A1 and expect the result to appear in cell B2.
In the same way you can't add a function in cell A1 and expect it to open another workbook to get its answer.
That's why it works in the immediate window and not as an Excel function.
You may be able to define a link to the other workbook and then reference that, but you can't get the function to physically open the other workbook.
Worksheet Functions (and user defined variants of these) are limited in terms of what they can and cannot do, here is a small excerpt from a Microsoft article regarding the matter:
https://support.microsoft.com/en-us/kb/170787
A user-defined function called by a formula in a worksheet cell cannot
change the environment of Microsoft Excel. This means that such a
function cannot do any of the following:
Insert, delete, or format cells on the spreadsheet.
Change another cell's value.
Move, rename, delete, or add sheets to a workbook.
Change any of the environment options, such as calculation mode or screen views.
Add names to a workbook.
Set properties or execute most methods.
The page goes on to state that:
Any environmental changes should be made through the use of a Visual Basic subroutine.
So in short, you cannot do what you're attempting to do with a worksheet UDF (User-Defined Function) and will need to change it to a sub routine.
I need to harvest and colate data from an oOcalc workbook.
Part of the information is presented as comments on the cell.
I cant figure out a formula to do it and Im not familiar with oOcalc DOM's to manipulate the item.
Hope someone can help me out.
Thanks.
Just had to figure this one out myself, so here is a macro that will copy the comments of cells in one sheet to actual cells in another sheet.
It could be better, but it gets the job done, so its not worth putting anymore (of my) time into!
REM ****** BASIC *********
Sub ExtractCommentAnnotationThings
Dim myDoc as Object
Dim originalSheet as Object
Dim newSheet as Object
Dim originalCell as Object
Dim newCell as Object
Dim commentString As String
REM DEFINE VAR FOR OUR LOOP
Dim iTargetRow, iTargetColumn As Long
Const kEndRow = 950
Const kEndColumn = 20
REM SET DOC
myDoc = ThisComponent
REM GET SHEET
originalSheet = myDoc.Sheets(0)
newSheet = myDoc.Sheets(1)
REM START LOOP
For iTargetRow = 0 To kEndRow: DoEvents
For iTargetColumn = 0 To kEndColumn: DoEvents
originalCell = originalSheet.getCellByPosition(iTargetColumn,iTargetRow)
REM commentString = Trim(originalCell.Comment.Text)
If originalCell.Annotation.isVisible = True Then
commentString = originalCell.getAnnotation().String
newCell = newSheet.getCellByPosition(iTargetColumn,iTargetRow)
newCell.String = commentString
End If
Next
Next
REM CONTINUE LOOP
End Sub
Set the kEndRow and kEndColumn to include only the range of cells you want copied.
Set the originalSheet and newSheetappropriately as well (might need to create a new sheet first), so they're copied where you want them to be.
Hope it helps!