I have the below code which will transfer the records from my datagrid to my excel spreadsheet.
Currently this code works for one datagrid to an excel sheet. Now I need to improve the below code so that it can work for multiple datagrids. I want help to extend this code so that I can pull the records from 3 data grids to the same excel sheet one below another.
Dim excel As Microsoft.Office.Interop.Excel.Application
Try
excel = New Microsoft.Office.Interop.Excel.Application
excel.Workbooks.Open("C:\Satish\TestExcel\vbexcel.xlsx")
Dim i As Integer, j As Integer
Dim diff As Integer = 1
' if you want column header from dgv elese omit the block
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
For j = 0 To DataGridView1.ColumnCount - 1
excel.Worksheets(1).cells(1, j + 1) = DataGridView1.Columns(j).Name
Next
diff += 1
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
For i = 0 To DataGridView4.RowCount - 1
If DataGridView4.Rows(i).IsNewRow = False Then
For j = 0 To DataGridView4.ColumnCount - 1
excel.Worksheets(1).cells(i + diff, j + 1) = DataGridView4.Item(j, i).Value
Next
End If
Next
excel.Worksheets(1).select()
excel.ActiveWorkbook().Save()
excel.Workbooks.Close()
excel.Quit()
excel = Nothing
Catch ex As System.Runtime.InteropServices.COMException
MessageBox.Show("Error accessing Excel: " + ex.ToString())
Catch ex As Exception
MessageBox.Show("Error: " + ex.ToString())
End Try
Try this code:
Dim intExcelRow As Integer = 1
For i As Integer = 1 To 3
Dim YourDataGridView As DataGridView = Me.Controls("YourDataGridView" & i)
'header of the first DataGridView only
'remove If i = 1 if you need to print 3 different headers
If i = 1 Then
For intColumn = 0 To YourDataGridView.ColumnCount - 1
excel.Worksheets(1).cells(intExcelRow, intColumn + 1) = YourDataGridView.Columns(intColumn).Name
Next intColumn
intExcelRow = intExcelRow + 1
End If
For intRow = 0 To YourDataGridView.RowCount - 1
If YourDataGridView.Rows(intRow).IsNewRow = False Then
For intColumn = 0 To YourDataGridView.ColumnCount - 1
excel.Worksheets(1).cells(intExcelRow, intColumn + 1) = YourDataGridView.Item(intColumn, intRow).Value
Next intColumn
intExcelRow = intExcelRow + 1
End If
Next intRow
Next i
Related
Good Morning
I have a program in VB.Net that exports a file from Datagridview into Excel file
and it looks like this.
My goal here is how can I lock some columns? based on the Image above? Lock all columns except the column that has a color yellow? I mean all the columns except the yellow are uneditable.
Here is my code in exporting excel
Try
If DataGridView1.Rows.Count = 0 Then
MsgBox("Nothing to Export")
Else
Dim ExcelApp As Object, ExcelBook As Object
Dim ExcelSheet As Object
Dim i As Integer
Dim J As Integer
Dim rowIndex As Integer = 1
Dim total As Double = 0
Dim indexTotal As Integer
ExcelApp = CreateObject("Excel.Application")
ExcelBook = ExcelApp.WorkBooks.Add
ExcelSheet = ExcelBook.WorkSheets(1)
With ExcelSheet
rowIndex += 2
For Each column As DataGridViewColumn In DataGridView1.Columns
.cells(rowIndex, column.Index + 1) = column.HeaderText
Next
.Range(.Cells(rowIndex, 1), .Cells(rowIndex, DataGridView1.Columns.Count)).Font.Bold = True
rowIndex += 1
For i = 0 To Me.DataGridView1.RowCount - 1
.cells(rowIndex, 1) = Me.DataGridView1.Rows(i).Cells("ItemCode").Value
For J = 1 To DataGridView1.Columns.Count - 1
If IsNumeric(DataGridView1.Rows(i).Cells(J).Value) Then
.cells(rowIndex, J + 1).NumberFormat = "#,##0.00"
.cells(rowIndex, J + 1) = DataGridView1.Rows(i).Cells(J).Value
Else
.cells(rowIndex, J + 1) = DataGridView1.Rows(i).Cells(J).Value
End If
'You can test also by index for example : if J = indexofTotalColumn then
If DataGridView1.Columns(J).Name = "Total" Then
total += DataGridView1.Rows(i).Cells(J).Value
indexTotal = J
End If
Next
rowIndex += 1
.Columns("A:Z").EntireColumn.AutoFit()
.Columns("L").ColumnWidth = 0
.cells(5).Locked = False
Next
.Protect("fakepwd")
End With
ExcelApp.Visible = True
ExcelSheet = Nothing
ExcelBook = Nothing
ExcelApp = Nothing
End If
Catch
End Try
TYSM for help
Set the Locked property of the cell to false, where J+1 is the desired column number.
For example to unlock column 5 :
For J = 1 To DataGridView1.Columns.Count - 1
If J=5 then
.cells(rowIndex, J + 1).Locked=False
End if
If IsNumeric(DataGridView1.Rows(i).Cells(J).Value) Then
..........
In the code, once you are done populating data in sheet, protect the sheet
Next
.Protect ("fakepwd")
End With
I have an application that can retrieves the install date and save it at a datagridview column with the format of date only.
But when I tried to export it to an excel file, even when I tried to format the cell, it still shows me datetime instead of date only for some of the data.
The code for exporting is shown below. btw I'm using vb.net
'reportFile : True = IE_Version_Report.xlsx False = Data.xlsx
Sub ExportData(reportFile)
Dim dSet As New DataSet
dSet.Tables.Add()
For i As Integer = 0 To DataGridView1.ColumnCount - 1
dSet.Tables(0).Columns.Add(DataGridView1.Columns(i).HeaderText)
Next
Dim dr As DataRow
For i As Integer = 0 To DataGridView1.RowCount - 1
dr = dSet.Tables(0).NewRow
For j As Integer = 0 To DataGridView1.Columns.Count - 1
dr(j) = DataGridView1.Rows(i).Cells(j).Value
Next
dSet.Tables(0).Rows.Add(dr)
Next
Dim Ex As Microsoft.Office.Interop.Excel.Application
Dim Wb As Microsoft.Office.Interop.Excel.Workbook
Dim Ws As Microsoft.Office.Interop.Excel.Worksheet
Dim misValue As Object = System.Reflection.Missing.Value
Ex = New Microsoft.Office.Interop.Excel.Application
Wb = Ex.Workbooks.Add(misValue)
Ws = Wb.Sheets("sheet1")
Dim dt As DataTable = dSet.Tables(0)
Dim col, row As Integer
Dim rawData(dt.Rows.Count, dt.Columns.Count - 1) As Object
For col = 0 To dt.Columns.Count - 1
rawData(0, col) = dt.Columns(col).ColumnName.ToUpper
Next
For col = 0 To dt.Columns.Count - 1
For row = 0 To dt.Rows.Count - 1
rawData(row + 1, col) = dt.Rows(row).ItemArray(col)
Next
Next
Dim finalColLetter As String = String.Empty
finalColLetter = ExcelColName(dt.Columns.Count)
Dim excelRange As String = String.Format("A1:{0}{1}", finalColLetter, dt.Rows.Count + 1)
Ws.Range(excelRange, Type.Missing).Value2 = rawData
Ws.Range("A1:L1").EntireColumn.AutoFit() 'columns in excel file will autofit according to the data
Dim num As Integer = DataGridView1.Rows.Count + 1
'set the format for dates in these few columns
Ws.Range("D2:D" & num).NumberFormat = "dd/mm/yyyy;#"
Ws.Range("F2:F" & num).NumberFormat = "dd/mm/yyyy;#"
Ws.Range("H2:H" & num).NumberFormat = "dd/mm/yyyy;#"
Ws.Range("J2:J" & num).NumberFormat = "dd/mm/yyyy;#"
Ws.Range("L2:L" & num).NumberFormat = "dd/mm/yyyy;#"
Ws = Nothing
If reportFile = True Then
fileExported = True
If System.IO.File.Exists(FolderPath & "\MSOffice_Report.xlsx") Then
System.IO.File.Delete(FolderPath & "\MSOffice_Report.xlsx")
End If
Wb.SaveAs(FolderPath & "\MSOffice_Report.xlsx")
Else
fileExported = False
If System.IO.File.Exists("C:\Install\MSData.xlsx") Then
System.IO.File.Delete("C:\Install\MSData.xlsx")
End If
Wb.SaveAs("C:\Install\MSData.xlsx")
SetAttr("C:\Install\MSData.xlsx", vbHidden)
End If
Wb.Close(True)
Wb = Nothing
Ex.Quit()
Ex = Nothing
GC.Collect()
End Sub
Public Function ExcelColName(ByVal Col As Integer) As String
If Col < 0 And Col > 256 Then
MsgBox("Invalid Argument", MsgBoxStyle.Critical)
Return Nothing
Exit Function
End If
Dim i As Int16
Dim r As Int16
Dim S As String
If Col <= 26 Then
S = Chr(Col + 64)
Else
r = Col Mod 26
i = System.Math.Floor(Col / 26)
If r = 0 Then
r = 26
i = i - 1
End If
S = Chr(i + 64) & Chr(r + 64)
End If
ExcelColName = S
End Function
Sorry if it's a very stupid question but I really don't know what's wrong with it.
Thanks!
Excel does not recognise dates earlier than 1/1/1900 and will treat a value like 11/11/1111 12:00:00 AM as text. See how the dates are right-aligned and the text is left aligned in your screenshot?
Text will not be affected by the number formatting you apply to show only the date of the values.
Depending on what you want to achieve, you need to adjust your code to handle the text values differently. Replace them with 1/1/1900 or some such.
I have been developing an Excel macro for my company that opens several workbooks, parses them for a specific line of information, stores that line, then once it has gone through each workbook sets the value of a horizontal selection of cells in a single workbook on one of two pages. The issue I am having is upon trying to select the second page I need to put data on to i get a runtime error 1004.
Here is the code;
Sub sortandinsert(listie As Variant)
'Takes in the data array and sorts it as it inserts it into the spreadsheet.
'Expects a 2 dimensional array.
Dim serialarray() As Variant
Dim listlen1 As Integer
Dim listlen2 As Integer
Dim listlen3 As Integer
Dim count1 As Integer
Dim count2 As Integer
Dim SSCcurrentrow As Integer
Dim DSCcurrentrow As Integer
Dim Colstart As Integer
Dim SSCcounter As Integer
Dim DSCcounter As Integer
Dim actbook As Workbook
Dim selectrange As range
Set actbook = ActiveWorkbook
SSCcounter = 0
DSCcounter = 0
Colstart = 1
SSCcurrentrow = 10
DSCcurrentrow = 10
serialarray = FindSerial(listie, serialarray)
listlen1 = findlength(serialarray)
For count = 0 To listlen1 - 1
MsgBox serialarray(count)
Next
With actbook
listlen2 = findlength(listie)
For count1 = 0 To listlen1 - 1
MsgBox "Current Serial is" & " " & serialarray(count1)
For count2 = 0 To listlen2 - 1
If contains(listie(count2), CStr(serialarray(count1))) Then
listlen3 = findlength(listie(count2))
If listie(count2)(0) = "SSC" Then
Set selectrange = Sheets("SSC").range(Cells(SSCcurrentrow + SSCcounter, Colstart), Cells(SSCcurrentrow + SSCcounter, Colstart + listlen3 - 1))
With selectrange
.Value = listie(count2)
End With
SSCcounter = SSCcounter + 1
ElseIf listie(count2)(0) = "DSC" Then
Set selectrange = Sheets("DSC").range(Cells(DSCcurrentrow + DSCcounter, Colstart), Cells(DSCcurrentrow + DSCcounter, Colstart + listlen3 - 1))
With selectrange
.Value = listie(count2)
End With
DSCcounter = DSCcounter + 1
End If
End If
Next
SSCcurrentrow = SSCcurrentrow + SSCcounter + 6
DSCcurrentrow = DSCcurrentrow + DSCcounter + 6
'SSCcounter = 0
'DSCcounter = 0
Next
End With
End Sub
The portion of the code where the error arises is;
Set selectrange = Sheets("DSC").range(Cells(DSCcurrentrow + DSCcounter, Colstart), Cells(DSCcurrentrow + DSCcounter, Colstart + listlen3 - 1))
With selectrange
.Value = listie(count2)
End With
At the beginning of the macro that I open a new workbook to put all the data into, then I open and close the workbooks containing the data, then return to the new workbook that was created. There is periodic saving happening over the course of the macro.
What can I do to fix this error?
Cells will reference the ActiveSheet in the ActiveWorkbook. Those objects might not be set, and they might not be on Sheet DSC. Try this instead:
With actbook.Sheets("DSC")
Set selectrange = range(.Cells(DSCcurrentrow + DSCcounter, Colstart), .Cells(DSCcurrentrow + DSCcounter, Colstart + listlen3 - 1))
End With
Or, a more readable version might be
Set selectrange = actbook.Sheets("DSC").Cells(DSCcurrentrow + DSCcounter, Colstart)
Set selectrange = selectrange.resize(1, listlen)
How can I set the column width and leave the top 10 rows empty in order to insert an image into my Excel report?
Here is my code:
If ComDset.Tables(0).Rows.Count > 0 Then
Try
With Excel
.SheetsInNewWorkbook = 1
.Workbooks.Add()
.Worksheets(1).Select()
Dim i As Integer = 1
For col = 0 To ComDset.Tables(0).Columns.Count - 1
.cells(1, i).value = ComDset.Tables(0).Columns(col).ColumnName
.cells(1, i).EntireRow.Font.Bold = True
i += 1
Next
i = 2
Dim k As Integer = 1
For col = 0 To ComDset.Tables(0).Columns.Count - 1
i = 2
For row = 0 To ComDset.Tables(0).Rows.Count - 1
.Cells(i, k).Value = ComDset.Tables(0).Rows(row).ItemArray(col)
i += 1
Next
k += 1
Next
filename = "ShiftReport" & Format(MdbDate, "dd-MM-yyyy") & ".xls"
.ActiveCell.Worksheet.SaveAs(filename)
End With
System.Runtime.InteropServices.Marshal.ReleaseComObject(Excel)
Excel = Nothing
Catch ex As Exception
MsgBox(ex.Message)
End Try
' The excel is created and opened for insert value. We most close this excel using this system
Dim pro() As Process = System.Diagnostics.Process.GetProcessesByName("EXCEL")
For Each i As Process In pro
i.Kill()
Next
End If
Range.ColumnWidth Property
Returns or sets the width of all columns in the specified range. Read/write Variant.
I am exporting data to excel and try to save to a folder which is in my application...but the excel is saving defaultly in C:\Documents but i wanted to save in E:\Apllication\Reports
Here is my code to generate excel sheet
If ComDset.Tables(0).Rows.Count > 0 Then
Try
With Excel
.SheetsInNewWorkbook = 1
.Workbooks.Add()
.Worksheets(1).Select()
Dim i As Integer = 1
For col = 0 To ComDset.Tables(0).Columns.Count - 1
.cells(1, i).value = ComDset.Tables(0).Columns(col).ColumnName
.cells(1, i).EntireRow.Font.Bold = True
i += 1
Next
i = 2
Dim k As Integer = 1
For col = 0 To ComDset.Tables(0).Columns.Count - 1
i = 2
For row = 0 To ComDset.Tables(0).Rows.Count - 1
.Cells(i, k).Value = ComDset.Tables(0).Rows(row).ItemArray(col)
i += 1
Next
k += 1
Next
filename = "ShiftReport" & Format(MdbDate, "dd-MM-yyyy") & ".xls"
.ActiveCell.Worksheet.SaveAs(filename)
End With
System.Runtime.InteropServices.Marshal.ReleaseComObject(Excel)
Excel = Nothing
Catch ex As Exception
MsgBox(ex.Message)
End Try
' The excel is created and opened for insert value. We most close this excel using this system
Dim pro() As Process = System.Diagnostics.Process.GetProcessesByName("EXCEL")
For Each i As Process In pro
i.Kill()
Next
End If
and tell me how to assign colour to the header
Thanks in advance
Have you tried this?
.ActiveCell.Worksheet.SaveAs("E:\Apllication\Reports\" & filename)