I am trying to export my userform listbox contents to a new workbook.
I am getting the error as I commented in the code.
Private Sub ExportListBoxContents_Click()
Dim xlApp As Excel.Application
Dim xlsh As Excel.Worksheet
Dim i As Integer
Dim j As Integer
Set xlApp = New Excel.Application
xlApp.Workbooks.Add
Set xlsh = xlApp.Workbooks(1).Worksheets(1)
For j = 1 To ListBox1.ListCount
For i = 0 To ListBox1.ColumnCount
xlsh.Cells(j, i).Value = ListBox1.List(j - 1, i) '<----Object defined error
Next i
Next j
xlApp.Visible = True
Set xlsh = Nothing
Set xlApp = Nothing
End Sub
Okay I have managed to solve it after so many hours and searching.
All I had to do is amend the line from this:
xlsh.Cells(j, i).Value = ListBox1.List(j - 1, i)
To this:
xlsh.Cells(j , i).Value = ListBox1.Column(j - 1, i - 1)
Related
I am trying to evaluate if specific cell value in an excel table is "" to use in an if statement in my VB.NET application. I modified the code that I use for writing to excel, but it doesn't work to get the cell value. The code I have:
Sub Excel_LoadProjectsSchedule()
xlApp = New Excel.Application
xlWorkBook = xlApp.Workbooks.Open("G:\100 Databases\Projects Schedule.xlsx")
xlApp.Visible = False
xlWorkSheet = xlWorkBook.Worksheets("sheet1")
Dim ProjectFinished as boolean
'Set variables
Result = xlWorkSheet.Cells.Find(ProjectNumber, LookAt:=Excel.XlLookAt.xlWhole)
If xlWorkSheet.Cells(Result.Row, 3).value = "" Then
ProjectFinished = False
Else
ProjectFinished = True
End If
'Save and close
xlApp.DisplayAlerts = False
xlWorkBook.Close(SaveChanges:=True)
xlApp.Quit()
End Sub
Error is on
If xlWorkSheet.Cells(Result.Row, 3).value = "" Then
And it says "System.MissingMemberException: 'Public member 'value' on type 'Range' not found.'
"
I do have
Public xlApp As Excel.Application = Nothing
Public xlWorkBook As Excel.Workbook = Nothing
Public xlWorkSheet As Excel.Worksheet = Nothing
Outside the sub in this module.
What am I doing wrong, could someone, please, help me solve this one?
I did some casting so the compiler can recognize the types.
Sub Excel_LoadProjectsSchedule(ProjectNumber As Integer)
Dim xlApp = New Excel.Application
Dim xlWorkBook = xlApp.Workbooks.Open("G:\100 Databases\Projects Schedule.xlsx")
xlApp.Visible = False
Dim xlWorkSheet = DirectCast(xlWorkBook.Worksheets("sheet1"), Excel.Worksheet)
Dim ProjectFinished As Boolean
'Set variables
Dim Result = xlWorkSheet.Cells.Find(ProjectNumber, LookAt:=Excel.XlLookAt.xlWhole)
Dim row = Result.Row
Dim cell = DirectCast(xlWorkSheet.Cells(row, 3), Excel.Range)
If cell.Value Is Nothing Then
'What do you want to do?
Else
If cell.Value.ToString = "" Then
ProjectFinished = False
Else
ProjectFinished = True
End If
End If
'Save and close
xlApp.DisplayAlerts = False
xlWorkBook.Close(SaveChanges:=True)
xlApp.Quit()
End Sub
I think if you specifically want to check contents in the 3rd Column of the Row with that Projectnumber you're not far away from the Solution.
I only tested it inside of VBA but something along the Lines of:
Sub Excel_LoadProjectsSchedule()
Dim xlWorksheet As Worksheet, Result As Range, ProjectFinished As Boolean
xlApp = New Excel.Application
xlWorkBook = xlApp.Workbooks.Open("G:\100 Databases\Projects Schedule.xlsx")
xlApp.Visible = False
Set xlWorkSheet = xlWorkBook.Worksheets("sheet1")
'Set variables
Set Result = xlWorksheet.Cells.Find(Projectnumber, LookIn:=Excel.XlLookin.xlValues, LookAt:=Excel.XlLookAt.xlWhole)
if not Result is nothing then
If Cells(Result.Row, 3).Value = "" Then
ProjectFinished = False
Else
ProjectFinished = True
End If
End Sub
The Problem being, that "Result" hasn't been asigned to a Range, so your code coudn't access the Row Property.
If looking for a certain cell in certain row .
Dim AppExcel As Object
Dim workBook As Object
AppExcel = CreateObject("Excel.Application")
workBook = AppExcel.Workbooks.Open("C:\SO\SO.xlsx")
AppExcel.Visible = False
Worksheets = workBook.worksheets
If Worksheets("Blad1").Cells(2, 3).text = "" Then
MessageBox.Show("Empty")
Else
MessageBox.Show("Text")
End If
Then the close part
I am using a code that works great - the purpose is to send info from Outlook to Excel so I can filter it and automatize the work.
The problem is: the VBA code is executing for all e-mails received and I only want to execute it onto e-mails with subject starting with "EK".
I already tried using InStr function as below, but it doesn't work:
If InStr(xMailItem.Subject, "EK") = 0 Then
Exit Sub
End If
Where should I put this line of code?
Private Sub GMailItems_ItemAdd(ByVal Item As Object)
Dim xMailItem As Outlook.MailItem
Dim xExcelFile As String
Dim xExcelApp As Excel.Application
Dim xWb As Excel.Workbook
Dim xWs As Excel.Worksheet
Dim xNextEmptyRow As Integer
Dim linhas As Variant, i As Integer
Dim linhaInicial As Long
Dim numeroCaracteresAssunto As Integer
Dim assuntoEmail As String
Dim k As Integer
On Error Resume Next
If (Item.Class <> olMail) Then Exit Sub
Set xMailItem = Item
xExcelFile = "EXCELFILEPATH.xlsx"
If IsWorkBookOpen(xExcelFile) = True Then
Set xExcelApp = GetObject(, "Excel.Application")
Set xWb = GetObject(xExcelFile)
If Not xWb Is Nothing Then xWb.Close True
Else
Set xExcelApp = New Excel.Application
End If
Set xWb = xExcelApp.Workbooks.Open(xExcelFile)
Set xWs = Sheets.Add
numeroCaracteresAssunto = Len(xMailItem.Subject)
assuntoEmail = Right(xMailItem.Subject, numeroCaracteresAssunto - 16)
xWs.Name = UCase(assuntoEmail)
xNextEmptyRow = xWs.Range("B" & xWs.Rows.Count).End(xlUp).Row + 1
linhaInicial = 1
With xWs
linhas = Split(xMailItem.Body, vbNewLine)
For i = 0 To UBound(linhas)
Cells(linhaInicial + i, 1).Value = linhas(i)
linhaInicial = linhaInicial + 1
Next
For k = 1 To i
xWs.Range("B" & k).FormulaLocal = "=SEERRO(ÍNDICE($A$1:$A$999;MENOR(SE(ÉNÚM(LOCALIZAR(""PC"";$A$1:$A$999));CORRESP(LIN($A$1:$A$999);LIN($A$1:$A$999)));" & k & "));"""")"
xWs.Range("B" & k).FormulaArray = xWs.Range("B" & k).Formula
Next k
End With
End Sub
Instr is not case sensitive.
If InStr(UCase(xMailItem.Subject), UCase("EK")) = 0 Then
Either UCase or LCase.
On both parts, or you may run into an "eK" typo.
I'm writing a simple app using vb.net that takes a user selected text file, populates a usoft excel worksheet, and creates a scatter plot chart of the data. The code compiles without error and when executing, produces the desired results up to the point when attempting to add a text box to the chart. That's when it produces a:
NullReferenceException was unhandled error, An unhandled exception of
type 'System.NullReferenceException' occurred in Graphing_Tool.exe.
Additional information: Object reference not set to an instance of an
object.
Included is an excerpt of my code. The highlited line is where it stops executing and produces the described error.
All of my attempts to date at correcting this error have failed. I'm beginning to think that text boxes cannot be added to excel charts using vb.net.
My OS is win10 and my IDE is visual studio 2012. Any help on resolving my issue would be greatly appreciated! Thanks.
Dim xlApp As Excel.Application = Nothing
Dim xlWorkBooks As Excel.Workbooks = Nothing
Dim xlWorkBook As Excel.Workbook = Nothing
Dim xlWorkSheet As Excel.Worksheet = Nothing
Dim xlWorkSheets As Excel.Sheets = Nothing
Dim xlCells As Excel.Range = Nothing
Dim SheetName As String = ""
'New instance of Excel and start a new workbook.
xlApp = New Excel.Application
xlApp.DisplayAlerts = False
xlWorkBooks = xlApp.Workbooks
xlWorkBook = xlWorkBooks.Add
xlWorkSheets = xlWorkBook.Worksheets
xlWorkSheet = xlWorkSheets(1)
xlApp.Visible = True
Dim maxTemp As Single = 0.0
Dim minTemp As Single = 10000.0
'Write data to excel sheet
With xlWorkSheet
tempCount = 0
Do While tempCount <= lineCount - 1
If (data(tempCount).PixelValue > maxTemp) Then
maxTemp = data(tempCount).PixelValue
End If
If (data(tempCount).PixelValue < minTemp) Then
minTemp = data(tempCount).PixelValue
End If
.Cells(tempCount + 1, 1) = data(tempCount).PixelNum
.Cells(tempCount + 1, 2) = data(tempCount).PixelValue
tempCount += 1
Loop
tempCount -= 1
End With
Erase data
'Calculate Thermal Resistance (Junction-Case)
Dim thermalResistance As Single = 0.0
thermalResistance = (maxTemp - CStr(CaseTemp)) / maxPower
thermalResistance = Math.Round(thermalResistance, 3, MidpointRounding.AwayFromZero)
Dim chartArea As Excel.Chart
Dim xlCharts As Excel.ChartObjects
Dim myChart As Excel.ChartObject
Dim chartRange As Excel.Range
xlCharts = xlWorkSheet.ChartObjects
myChart = xlCharts.Add(300, 80, 500, 250)
chartArea = myChart.Chart
With chartArea
chartRange = xlWorkSheet.Range("A:B")
.SetSourceData(Source:=chartRange)
.ChartType = Excel.XlChartType.xlXYScatterLinesNoMarkers
.HasTitle = True
.HasLegend = False
.ChartTitle.Text = "Temperature Data Trace SN= " & PN
.SeriesCollection(1).delete
.SeriesCollection(1).Format.Line.ForeColor.RGB = RGB(255, 0, 0)
Dim xlAxisCategory, xlAxisValue As Excel.Axes
xlAxisCategory = CType(chartArea.Axes(, Excel.XlAxisGroup.xlPrimary), Excel.Axes)
xlAxisCategory.Item(Excel.XlAxisType.xlCategory).HasTitle = True
xlAxisCategory.Item(Excel.XlAxisType.xlCategory).AxisTitle.Characters.Text = "Pixel Count"
xlAxisValue = CType(chartArea.Axes(, Excel.XlAxisGroup.xlPrimary), Excel.Axes)
xlAxisValue.Item(Excel.XlAxisType.xlValue).HasTitle = True
xlAxisValue.Item(Excel.XlAxisType.xlValue).AxisTitle.Characters.Text = "Temperature (Degrees C)"
xlAxisValue.Item(Excel.XlAxisType.xlValue).MinimumScale = Int(0.9 * minTemp)
End With
**Dim oShape As Excel.Shape = xlApp.ActiveChart.Shapes.AddLabel(Microsoft.Office.Core.MsoTextOrientation.msoTextOrientationHorizontal, 320, 100, 500, 250)**
oShape.TextFrame2.TextRange.Text = "some text"
I have a DataGridView and a button that exports the values of the DataGridView to excel. The question is how can I set the values to non editable or read only when it is sent to the excel? And what is the code to set the default cell sizes of the value where it will be displayed?
Here is my code of the Button:
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim App_xls As Object
Dim Lig_cpt, Col_cpt As Integer
App_xls = CreateObject("Excel.Application")
App_xls.workbooks.add()
App_xls.visible = True
Try
For Col_cpt = 0 To DataGridView1.ColumnCount - 1
App_xls.ActiveSheet.cells(1, Col_cpt + 1).value = DataGridView1.Columns(Col_cpt).HeaderText
Next
For Lig_cpt = 0 To DataGridView1.Rows.Count - 1
For Col_cpt = 0 To DataGridView1.ColumnCount - 1
If IsNumeric(DataGridView1.Item(Col_cpt, Lig_cpt).Value) Then
App_xls.ActiveSheet.cells(Lig_cpt + 2, Col_cpt + 1).value = CDbl(DataGridView1.Item(Col_cpt, Lig_cpt).Value)
Else
App_xls.ActiveSheet.cells(Lig_cpt + 2, Col_cpt + 1).value = DataGridView1.Item(Col_cpt, Lig_cpt).Value
End If
Next
Next
Catch ex As Exception
End Try
End Sub
`
By default all cells are set as not editable (locked) for a worksheet. But the feature becomes active only when the sheet is protected. Optionally you can set also a password for protection.
The function that can be used for this purpose is Excel.Worksheet.Protect.
If you need any cells to be editable, you must unlocked those cells.
Imports System.Data
Imports System.Data.SqlClient
Imports Excel = Microsoft.Office.Interop.Excel
Public Class Form1
Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
Dim xlApp As Excel.Application
Dim xlWorkBook As Excel.Workbook
Dim xlWorkSheet As Excel.Worksheet
Dim misValue As Object = System.Reflection.Missing.Value
Dim i As Integer
Dim j As Integer
xlApp = New Excel.ApplicationClass
xlWorkBook = xlApp.Workbooks.Add(misValue)
xlWorkSheet = xlWorkBook.Sheets("sheet1")
For i = 0 To DataGridView1.RowCount - 2
For j = 0 To DataGridView1.ColumnCount - 1
xlWorkSheet.Cells(i + 1, j + 1) = _
DataGridView1(j, i).Value.ToString()
Next
Next
xlWorkSheet.SaveAs("C:\vbexcel.xlsx")
xlWorkBook.Close()
xlApp.Quit()
releaseObject(xlApp)
releaseObject(xlWorkBook)
releaseObject(xlWorkSheet)
MsgBox("You can find the file C:\vbexcel.xlsx")
End Sub
Private Sub releaseObject(ByVal obj As Object)
Try
System.Runtime.InteropServices.Marshal.ReleaseComObject(obj)
obj = Nothing
Catch ex As Exception
obj = Nothing
Finally
GC.Collect()
End Try
End Sub
End Class
To export from DGV to excel, try the script below.
Imports Excel = Microsoft.Office.Interop.Excel
Imports System.Data.OleDb
'~~> Define your Excel Objects
Public Class Form1
Private Sub Button3_Click(sender As System.Object, e As System.EventArgs) Handles Button3.Click
Dim xlApp As Excel.Application
Dim xlWorkBook As Excel.Workbook
Dim xlWorkSheet As Excel.Worksheet
Dim misValue As Object = System.Reflection.Missing.Value
Dim i As Integer
Dim j As Integer
xlApp = New Excel.Application
xlWorkBook = xlApp.Workbooks.Add(misValue)
xlWorkSheet = xlWorkBook.Sheets("sheet1")
For Each col As DataGridViewColumn In Me.DataGridView1.Columns
xlWorkSheet.Cells(1, col.Index + 1) = col.HeaderText.ToString
Next
Try
For CurrentRowIndex = 0 To DataGridView1.RowCount - 1 'current row index
'For j = 0 To Me.DataGridView1.ColumnCount
For CurrentColumnIndex = 0 To DataGridView1.ColumnCount - 1 'current column index within row index
xlWorkSheet.Cells(2, CurrentColumnIndex + 1) = DataGridView1.Columns(CurrentColumnIndex).HeaderText 'display header
xlWorkSheet.Cells(CurrentRowIndex + 3, CurrentColumnIndex + 1) = DataGridView1(CurrentColumnIndex, CurrentRowIndex).Value.ToString()
Next
'xlWorkSheet.Cells(2, CurrentColumnIndex + 1) = DataGridView1.Columns(CurrentColumnIndex).HeaderText 'display header
'xlWorkSheet.Cells(i + 2, j + 1) = Me.DataGridView1(j, i).Value.ToString()
'xlWorkSheet.Cells(2, CurrentColumnIndex + 1) = DataGridView1.Columns(CurrentColumnIndex).HeaderText 'display header
'Next
Next
Catch ex As Exception
MsgBox("Unable to extract data" & ex.Message, MsgBoxStyle.Critical)
Exit Sub
End Try
xlWorkBook.Activate()
'//get path
Me.FolderBrowserDialog1.ShowDialog()
Dim path As String = Me.FolderBrowserDialog1.SelectedPath
xlWorkBook.SaveAs(path & "\Excel_With_Headers.xls")
'xlWorkSheet.SaveAs("burn permit export.xls")
xlWorkBook.Close()
xlApp.Quit()
'releaseObject(xlApp)
'releaseObject(xlWorkBook)
'releaseObject(xlWorkSheet)
MsgBox("You can find your report at " & path & "\burn permit export.xls")
End Sub
End Class
You can try this as well.
Private Sub Button4_Click(sender As System.Object, e As System.EventArgs) Handles Button4.Click
Dim xlApp As Excel.Application
Dim xlWorkBook As Excel.Workbook
Dim xlWorkSheet As Excel.Worksheet
Dim misValue As Object = System.Reflection.Missing.Value
Dim i As Integer
Dim j As Integer
xlApp = New Excel.Application
xlWorkBook = xlApp.Workbooks.Add(misValue)
xlWorkSheet = xlWorkBook.Sheets("sheet1")
Try
For CurrentRowIndex = 0 To DataGridView1.RowCount - 1 'current row index
'xlWorkSheet.Cells(1, 1) = "With Headers"
For CurrentColumnIndex = 0 To DataGridView1.ColumnCount - 1 'current column index within row index
xlWorkSheet.Cells(2, CurrentColumnIndex + 1) = DataGridView1.Columns(CurrentColumnIndex).HeaderText 'display header
xlWorkSheet.Cells(CurrentRowIndex + 3, CurrentColumnIndex + 1) = DataGridView1(CurrentColumnIndex, CurrentRowIndex).Value.ToString()
Next
Next
Catch ex As Exception
MsgBox("Unable to extract data" & ex.Message, MsgBoxStyle.Critical)
Exit Sub
End Try
End Sub
I'm trying to fill formulas in excel sheet from access db VBA.I referred this
Here is my code
Dim xlApp As Excel.Application
Dim wb As Workbook
Dim strFormulas(1 To 4) As Variant
txtcatpath = Form_Bom.Excelpath.Value
Set xlApp = CreateObject("Excel.Application")
With xlApp
Set wb = .Workbooks.Open(txtcatpath)
.Visible = True
End With
With wb.Sheets("common based")
strFormulas(1) = "=IF(F4<>F5,E4,E4&""&H5)"
strFormulas(2) = "=VLOOKUP(J4,F:H,3,FALSE)"
strFormulas(3) = "=IF(COUNTIF(F4:F900,F4)=1,F4,"")"
strFormulas(4) = "=SUMIF(F:F,J4,G:G)"
.Range("H4:K4").Formula = strFormulas
.Range("H4:K" & LRow & "").FillDown
End With
When debugging my code is getting broken in .Range("H4:K4").Formula = strFormulas. How do i fill the columns with the formula.