How do I populate multiple worksheets in a workbook from vb.net
Hello,
I have developed the following code (with the frequent help of experts-exchange) that loops through checked items in a datagridview and populates workbooks. So for example, if three items are selected from a datagridview, those items are used to populate three different workbooks with the corresponding data pertaining to that selection. I'm now trying to modify the code so that instead of populating different workbooks - Yes you've guessed it, I now want to populate mutiple sheets in a single workbook. So if five items are selected in the datagridview, those five items would be used to populate five sheets in a workbook
I have developed the following code (with the frequent help of experts-exchange) that loops through checked items in a datagridview and populates workbooks. So for example, if three items are selected from a datagridview, those items are used to populate three different workbooks with the corresponding data pertaining to that selection. I'm now trying to modify the code so that instead of populating different workbooks - Yes you've guessed it, I now want to populate mutiple sheets in a single workbook. So if five items are selected in the datagridview, those five items would be used to populate five sheets in a workbook
Private Sub btnExport_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnExport.Click
Dim dgl As New List(Of DatasetGroup)
For Each row As DataGridViewRow In dgvDatasetGroups.Rows
Dim cell As DataGridViewCell = row.Cells(8)
If CBool(cell.Value) = True Then
Dim dg As New DatasetGroup
Dim indexcell As DataGridViewCell = row.Cells(0)
dg.DatasetGroupId = indexcell.Value
dgl.Add(dg)
End If
Next
For Each dg As DatasetGroup In dgl
CreateGraphTable(Convert.ToInt32(dg.DatasetGroupId))
Next
End Sub
Private Sub CreateGraphTable(ByVal intDatasetGroupId) 'As DataTable
Dim graphs As New List(Of GraphReport)
Dim dset As New DataSet("MyDataSet")
Dim strTitleName As String = ""
Dim strUnits As String = ""
Dim dpl As New List(Of DatasetPair)
Try
dpl = DatasetPairDB.GetExportDatasetGroupDetail(intDatasetGroupId)
For Each dp As DatasetPair In dpl
Dim objgraph As New GraphReport
objgraph.DataVersionIdOne = dp.DataVersionIdOne.ToString
objgraph.DataVersionIdTwo = dp.DataVersionIdTwo.ToString
objgraph.MetricName = dp.MetricName.ToString
objgraph.GraphTitle = "TEST"
objgraph.GraphType = dp.GraphType
graphs.Add(objgraph)
Next
For Each g As GraphReport In graphs
If MatchingMetricUnits(g) = Nothing Then
MessageBox.Show(g.DataVersionIdOne.ToString & " and " & g.DataVersionIdTwo.ToString & " do not have corresponding units!", "Erro")
'Return Nothing
Exit Sub
Else
strUnits = MatchingMetricUnits(g)
Units = strUnits
End If
Dim ds As New DataTable
ds = ReportDB.GetDeltaSeriesData(g.DataVersionIdOne, g.DataVersionIdTwo, g.MetricName)
Dim dtgv As New DataTable
dtgv = ReportDB.GetDeltaReportData(g.DataVersionIdOne, g.DataVersionIdTwo, g.MetricName)
If dtgv.Rows.Count < 1 Then
MessageBox.Show("No Data")
Exit Sub
End If
Dim newtable As New DataTable
dset.Tables.Add(dtgv)
For Each table As DataTable In dset.Tables
newtable.Merge(table)
Next
dgvGraphResults.DataSource = newtable
Me.DgvTable = newtable
Dim strSeriesName As String = g.DataVersionIdOne.ToString & " - " & g.DataVersionIdTwo.ToString
MySeriesName = strSeriesName
strTitleName = g.GraphTitle.ToString
MyMetricName = g.GraphTitle.ToString
MyGraphStyle = g.GraphType
Next
Dim strGraphStyle As String = MyGraphStyle
Utilities.ExportMultipleGraphToExcel(DgvTable, MyMetricName, Units, strGraphStyle)
Catch ex As Exception
MessageBox.Show(ex.Message.ToString & Err.Number.ToString)
End Try
End Sub
Private Function MatchingMetricUnits(ByVal g As GraphReport) As String
Dim strMetricUnitsOne As String
Dim strMetricUnitsTwo As String
strMetricUnitsOne = MetricsDB.GetMetricUnits(g.DataVersionIdOne.ToString, g.MetricName.ToString)
strMetricUnitsTwo = MetricsDB.GetMetricUnits(g.DataVersionIdTwo.ToString, g.MetricName.ToString)
If strMetricUnitsOne = strMetricUnitsTwo Then
Return strMetricUnitsOne
Else
Return Nothing
End If
End Function
ASKER
My mistake. I forgot to include the code for that function. I've attached it below
Public Shared Sub ExportMultipleGraphToExcel(ByVal datTable As DataTable, ByVal strMetricName As String, ByVal strUnits As String, ByVal strGraphStyle As String)
Dim filename As String
Dim excelApp As New Excel.Application
Dim savefiledialog1 As New SaveFileDialog
If My.Settings.DefaultLocation = "" Then
savefiledialog1.InitialDirectory = "C:\"
Else
savefiledialog1.InitialDirectory = My.Settings.DefaultLocation.ToString
End If
savefiledialog1.Filter = "xlsx files (*.xlsx)|*.xlsx"
savefiledialog1.FilterIndex = 2
savefiledialog1.RestoreDirectory = True
'Try
'***************************Creates Spreadsheet*********************************************
If savefiledialog1.ShowDialog = Windows.Forms.DialogResult.OK Then
filename = savefiledialog1.FileName
If Not datTable Is Nothing AndAlso datTable.Rows.Count > 0 Then
'Validate file name
If Convert.ToString(filename) = "" Then Exit Sub
'Create excel instance
Dim excelWorkbook As Excel.Workbook
Dim excelSheet As Excel.Worksheet
Dim misValue As Object = System.Reflection.Missing.Value
excelApp = New Excel.ApplicationClass
'excelApp.Visible = True
excelWorkbook = excelApp.Workbooks.Add(misValue)
excelSheet = excelWorkbook.Sheets("sheet1")
excelApp.ScreenUpdating = True
'MessageBox.Show(System.Guid.NewGuid.ToString.ToUpper)
excelApp.Caption = System.Guid.NewGuid.ToString.ToUpper
' Dim visibleColCount As Integer = 0
Dim i As Integer
Dim j As Integer
' Copy array of object for store data
Dim xlDataTable As DataTable = Nothing
xlDataTable = datTable
' xlDataTable.Columns.Remove("BudgetYear")
xlDataTable.Columns.Remove("MetricName")
'xlDataTable.Columns.Remove("Units")
'xlDataTable.Columns.Remove("TechnologySetCode")
Dim rawData(xlDataTable.Rows.Count, xlDataTable.Columns.Count - 1) As Object
'Counter for adding visible columns to array
Dim colCounter As Int16 = 0
For i = 0 To xlDataTable.Columns.Count - 1
'Str += dt.Columns(i).HeaderText & vbTab
rawData(0, colCounter) = xlDataTable.Columns(i).ColumnName
colCounter += 1
Next
'Counter for add rows in array
For i = 0 To xlDataTable.Rows.Count - 1
colCounter = 0
For j = 0 To xlDataTable.Columns.Count - 1
' Copy the values to the object array
rawData(i + 1, colCounter) = xlDataTable.Rows(i)(j)
colCounter += 1
Next
Next
' Calculate the final column letter
Dim finalColLetter As String = String.Empty
Dim colCharset As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Dim colCharsetLen As Integer = colCharset.Length
If xlDataTable.Columns.Count > colCharsetLen Then
finalColLetter = colCharset.Substring( _
(xlDataTable.Columns.Count - 1) \ colCharsetLen - 1, 1)
End If
finalColLetter += colCharset.Substring((xlDataTable.Columns.Count - 1) Mod colCharsetLen, 1)
' Fast data export to Excel
Dim excelRange As String = String.Format("A1:{0}{1}", finalColLetter, xlDataTable.Rows.Count + 1)
'****The following code is used to create variables that will be used in the Create Graph section****
'Creates an array to hold the upper and lower limits of the range of the excel table
Dim strExcelRange As String() = excelRange.Split(CChar(":"))
'Stores the first cell in the range
Dim strFirstCell As String = strExcelRange(0)
'Stores the last cell in the range
Dim strLastCell As String = strExcelRange(1)
'*****************************************************************************************************
excelSheet.Range(excelRange, misValue).Value2 = rawData
' Mark the first row as BOLD
CType(excelSheet.Rows(1, Type.Missing), Excel.Range).Font.Bold = True
'---------------------------Create Graph----------------------------------------------
'create chart objects
Dim oChart As Excel.Chart
Dim MyCharts As Excel.ChartObjects
Dim MyCharts1 As Excel.ChartObject
MyCharts = excelSheet.ChartObjects
'set chart location
MyCharts1 = MyCharts.Add(150, 290, 400, 250)
oChart = MyCharts1.Chart
'use the follwoing line if u want
'to draw chart on the default location
oChart.Location(Excel.XlChartLocation.xlLocationAsObject, excelSheet.Name)
Dim R As Integer = xlDataTable.Rows.Count + 1
'MessageBox.Show(R.ToString)
With oChart
'set data range for chart
Dim chartRange As Excel.Range
chartRange = excelSheet.Range(strFirstCell, strLastCell)
.SetSourceData(chartRange)
'set how you want to draw chart i.e column wise or row wise
'.PlotBy = Excel.XlRowCol.xlColumns
.PlotBy = Excel.XlRowCol.xlRows
.SeriesCollection(1).Delete()
'MessageBox.Show("Total Number of dataseries " & .SeriesCollection.count.ToString)
'set data lables for bars
.ApplyDataLabels(Excel.XlDataLabelsType.xlDataLabelsShowNone)
'set legend to be displayed or not
.HasLegend = True
'set legend location
.Legend.Position = Excel.XlLegendPosition.xlLegendPositionRight
'select chart type
Select Case strGraphStyle
Case "xlLine"
.ChartType = Excel.XlChartType.xlLine
For Each excChartSeries As Excel.Series In oChart.SeriesCollection
excChartSeries.MarkerStyle = Excel.XlMarkerStyle.xlMarkerStyleAutomatic
Next
Case "xlColumnClustered"
.ChartType = Excel.XlChartType.xlColumnClustered
Case "xlAreaStacked"
.ChartType = Excel.XlChartType.xlAreaStacked
Case "xlColumnStacked"
.ChartType = Excel.XlChartType.xlColumnStacked
End Select
Dim Headers As String() = Nothing
'Set to number of new headers
Dim intH As Integer = 1
ReDim Headers(intH)
Headers(0) = "MetricName"
Dim strx As String = "A1"
Dim c As Integer = 0
'For c As Integer = 0 To 1
excelApp.Range("A:A").Insert(Excel.XlDirection.xlToRight)
excelApp.Range(strx).Value = Headers(c).ToString
'Next c
For t As Integer = 1 To chartRange.Rows.Count
If t = 1 Then
Continue For
Else
Dim z As String = ""
'z = excelApp.Range("A" & t).Value.ToString
' Dim strDvid As String() = z.Split(CChar("-"))
Dim strT As String = t.ToString
excelApp.Range("A" & strT).Value = strMetricName
excelSheet.Range("A:A").HorizontalAlignment = Excel.Constants.xlCenter
End If
Next
'chart title
.HasTitle = True
.ChartTitle.Text = strMetricName
'set titles for Axis values and categories
Dim xlAxisCategory, xlAxisValue As Excel.Axes
xlAxisCategory = CType(oChart.Axes(, Excel.XlAxisGroup.xlPrimary), Excel.Axes)
xlAxisCategory.Item(Excel.XlAxisType.xlCategory).HasTitle = True
xlAxisCategory.Item(Excel.XlAxisType.xlCategory).AxisTitle.Characters.Text = "Forecast Years"
If xlDataTable.Columns.Count > colCharsetLen Then
finalColLetter = colCharset.Substring( _
(xlDataTable.Columns.Count - 1) \ colCharsetLen - 1, 1)
End If
finalColLetter += colCharset.Substring( _
(xlDataTable.Columns.Count - 1 + intH) Mod colCharsetLen, 1)
excelRange = String.Format("A1:{0}{1}", finalColLetter, xlDataTable.Rows.Count + 1)
'****The following code is used to create variables that will be used in the Create Graph section****
'Creates an array to hold the upper and lower limits of the range of the excel table
Dim strChartRange As String() = excelRange.Split(CChar(":"))
'Stores the first cell in the range
strFirstCell = strChartRange(0)
'Stores the last cell in the range
strLastCell = strChartRange(1)
'MessageBox.Show(Mid(strLastCell, 1, Len(strLastCell) - 1).ToString)
.SeriesCollection(1).XValues = "=Sheet1!$C$1:$" & Mid(strLastCell, 1, Len(strLastCell) - 1) & "$1"
'.SeriesCollection(1).XValues = "=Sheet1!$F$1:$N$1"
xlAxisValue = CType(oChart.Axes(, Excel.XlAxisGroup.xlPrimary), Excel.Axes)
xlAxisValue.Item(Excel.XlAxisType.xlValue).HasTitle = True
xlAxisValue.Item(Excel.XlAxisType.xlValue).AxisTitle.Characters.Text = strUnits
excelSheet.Range("A2", strLastCell).NumberFormat = "0.0"
MessageBox.Show("Chart Completed")
End With
'Set file format number to 56 if excel version <> 2007
If Not filename.EndsWith(".xlsx") Then
excelWorkbook.SaveAs(filename, 56)
Else
excelWorkbook.SaveAs(filename)
End If
MsgBox("File generated successfully at " & filename)
End If
End If
'Catch ex As Exception
'MessageBox.Show(ex.Message.ToString)
'Finally
If Not excelApp.Workbooks Is Nothing Then
Dim wb As Microsoft.Office.Interop.Excel.Workbook
Dim ws As Microsoft.Office.Interop.Excel.Worksheet
For Each wb In excelApp.Workbooks
For Each ws In wb.Worksheets
Marshal.FinalReleaseComObject(ws)
ws = Nothing
Next
wb.Close(False)
Marshal.FinalReleaseComObject(wb)
wb = Nothing
Next
excelApp.Workbooks.Close()
End If
excelApp.DisplayAlerts = False
excelApp.Quit()
GC.Collect()
GC.WaitForPendingFinalizers()
If excelApp IsNot Nothing Then
Dim excelProcessId As Integer
GetWindowThreadProcessId(New IntPtr(excelApp.Hwnd), excelProcessId)
If excelProcessId > 0 Then
KillExcel(excelApp)
End If
End If
'End Try
End Sub
ASKER
I've had some additional thoughts. Why don't I create a function called create workbook which would create a workbook and return the file path of that workbook. I could call that function from the click event of the export button. I can then pass the returned file path to other code which could open it and populate the workbooks sheets via a loop. I'm just thinkng out loud here
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Thanks. Your advice put me on the right track
If that is not a custom function that you have access to the code for, then you will have to rewrite the entire feature from scratch.