|
-
August 1st, 2012, 10:46 PM
#1
Datatable convert to xml and export to excel
May I know is there anyone did this before? I have the code below:
Code:
Private Function FnReadWeeklyConsumption(ByVal pstrSheetName As String, _
ByVal Report_Type As Integer, ByVal Branch_ID As String, _
ByVal Start_Date As Date, ByVal End_Date As Date, _
ByVal Report_Title As String, ByVal CurrentBrand As String, ByVal Product_ID As String, ByVal AsAtDate As Date) As Boolean
Dim intStartHeaderRow As Integer = 0, intStartHeaderColumn As Integer = 0, intRow As Integer = 0, intRecHeader As Integer = 0, _
intRecBody As Integer = 0, intSN As Integer = 0, intBranchRow As Integer = 0
Dim dtDetail As New DataTable, dtAllBranch As New DataTable
Dim paramap As New Hashtable
Dim aryBody As Object()
Dim strTempProductID As String = String.Empty
intStartHeaderRow = 6
intStartHeaderColumn = 1
paramap.Add("Report_Type", Report_Type)
paramap.Add("Branch_ID", Branch_ID)
paramap.Add("Start_Date", Start_Date)
paramap.Add("End_Date", End_Date)
paramap.Add("Search_By1", "")
paramap.Add("Search_By2", "")
paramap.Add("Search_By3", "")
paramap.Add("Search_By4", "")
paramap.Add("Report_Title", Report_Title)
paramap.Add("ProductID", "")
paramap.Add("AsAtDate", AsAtDate)
Try
'Read Weekly Consumption
dtDetail = bcBizMgmt_Reports.FnReadLogisticStock(paramap)
'Filter Data''''''''''''''''''''''''''''''''''''
If Branch_ID <> "-" Then
dtDetail.DefaultView.RowFilter = "Branch_ID = '" & Branch_ID & "'"
dtDetail = dtDetail.DefaultView.ToTable
End If
If Product_ID <> "-" Then
dtDetail.DefaultView.RowFilter = "Product_ID = '" & Product_ID & "'"
dtDetail = dtDetail.DefaultView.ToTable
End If
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
If dtDetail.Rows.Count > 0 Then
Dim xExcelApp As New Excel.Application()
Dim xExcelWorkBooks As Excel.Workbooks = xExcelApp.Workbooks
Dim xExcelWorkBook As Excel.Workbook = xExcelWorkBooks.Add
Dim xExcelSheets As Object = xExcelWorkBook.Worksheets
If xExcelApp Is Nothing Then
Throw (New Exception("Unable to Start Microsoft Excel."))
End If
Try
With xExcelSheets(1)
.Name = "Outlet Weekly Order Report"
.Activate()
.PageSetup.Orientation = Excel.XlPageOrientation.xlLandscape
.PageSetup.Zoom = False
.PageSetup.FitToPagesTall = 1
.PageSetup.FitToPagesWide = 1
.PageSetup.RightMargin = .Application.InchesToPoints(0.05)
.PageSetup.LeftMargin = .Application.InchesToPoints(0.05)
.PageSetup.TopMargin = .Application.InchesToPoints(0.05)
.PageSetup.BottomMargin = .Application.InchesToPoints(0.2)
Try
Select Case CurrentBrand
Case "NYSS"
.Shapes.AddPicture(strStartupPath & "DSR\NYSS_big.png", Microsoft.Office.Core.MsoTriState.msoFalse, Microsoft.Office.Core.MsoTriState.msoCTrue, 0, 0, 150, 50)
Case "LWM"
.Shapes.AddPicture(strStartupPath & "DSR\LWM_big.png", Microsoft.Office.Core.MsoTriState.msoFalse, Microsoft.Office.Core.MsoTriState.msoCTrue, 0, 0, 150, 50)
Case "YN"
.Shapes.AddPicture(strStartupPath & "DSR\YN_big.png", Microsoft.Office.Core.MsoTriState.msoFalse, Microsoft.Office.Core.MsoTriState.msoCTrue, 0, 0, 150, 50)
Case "HQ"
.Shapes.AddPicture(strStartupPath & "DSR\hq_big.png", Microsoft.Office.Core.MsoTriState.msoFalse, Microsoft.Office.Core.MsoTriState.msoCTrue, 0, 0, 150, 50)
Case "DORRA"
.Shapes.AddPicture(strStartupPath & "DSR\Dorra_Big.png", Microsoft.Office.Core.MsoTriState.msoFalse, Microsoft.Office.Core.MsoTriState.msoCTrue, 0, 0, 150, 50)
Case "SKR"
.Shapes.AddPicture(strStartupPath & "DSR\skr_big.png", Microsoft.Office.Core.MsoTriState.msoFalse, Microsoft.Office.Core.MsoTriState.msoCTrue, 0, 0, 150, 50)
End Select
Catch ex As Exception
End Try
'Bind Excel Header''''''''''''''''''''''''''''''''''''
.Cells(intStartHeaderRow, (dtDetail.Columns.Count / 2)).Value = Report_Title
.Cells(intStartHeaderRow, (dtDetail.Columns.Count / 2)).font.size = 18
.Cells(intStartHeaderRow, (dtDetail.Columns.Count - 4)).Value = "Print By: " + FnReadstrStaffID()
.Cells(intStartHeaderRow + 1, (dtDetail.Columns.Count - 4)).Value = "Print Date: " + Format(Date.Now, date_info.ShortDatePattern)
.Cells(intStartHeaderRow + 2, (dtDetail.Columns.Count - 4)).Value = "Print Time: " + Format(Date.Now, date_info.ShortTimePattern)
intStartHeaderRow += 1
'Bind Body Header''''''''''''''''''''
intStartHeaderRow += 1
intStartHeaderColumn = 1
Dim arrColumn(6) As String
Dim arrLength(6) As String
Dim arrHeader() As String
arrColumn = New String() {"Product ID", "Branch ID", "Company ID", "Tolerance", "Exception Days", "Total Days", "Consumption After Exception", "Weekly Average", "Min Tolerance", "Max Tolerance"}
arrLength = New String() {"10", "8", "8", "10", "10", "10", "10", "10", "10", "10"}
ReDim arrHeader(99)
For intRow = 0 To arrColumn.Length - 1
If intRow = 3 Then
Dim intDays As Integer = 6
For intRow1 = 1 To dtDetail.Columns.Count - 10
.Cells(intStartHeaderRow, intStartHeaderColumn).Value = DateAdd(DateInterval.Day, -182 + intDays, End_Date).ToString("dd-MMM-yy")
.Cells(intStartHeaderRow, intStartHeaderColumn).ColumnWidth = 10
intStartHeaderColumn += 1
intDays += 7
Next
End If
.Cells(intStartHeaderRow, intStartHeaderColumn).Value = arrColumn(intRow)
.Cells(intStartHeaderRow, intStartHeaderColumn).ColumnWidth = CInt(arrLength(intRow))
intStartHeaderColumn += 1
Next
.Range(.Cells(intStartHeaderRow, intStartHeaderColumn), .Cells(intStartHeaderRow, intStartHeaderColumn + intRecHeader)).Value2 = arrHeader
.Range(.Cells(intStartHeaderRow, 1), .Cells(intStartHeaderRow, intStartHeaderColumn)).Font.Bold = True
.Range(.Cells(intStartHeaderRow, 1), .Cells(intStartHeaderRow, intStartHeaderColumn)).Font.Size = 9
.Range(.Cells(intStartHeaderRow, 1), .Cells(intStartHeaderRow, intStartHeaderColumn)).HorizontalAlignment = Excel.XlHAlign.xlHAlignCenter
.Range(.Cells(intStartHeaderRow, 1), .Cells(intStartHeaderRow, intStartHeaderColumn)).WrapText = True
.Range(.Cells(intStartHeaderRow, 1), .Cells(intStartHeaderRow, intStartHeaderColumn)).RowHeight = 40
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
For intStyle = 1 To intStartHeaderColumn - 1
.Range(.Cells(intStartHeaderRow, intStyle), .Cells(intStartHeaderRow, intStyle)).BorderAround(LineStyle:=Excel.XlLineStyle.xlContinuous)
Next
'Bind Body'''''''''''''''''''''''''''''''''''''''''''''''
For intRow = 0 To dtDetail.Rows.Count - 1
intStartHeaderRow += 1
intStartHeaderColumn = 1
intRecBody = 0
ReDim aryBody(99)
For intRow2 = 0 To dtDetail.Columns.Count - 1
aryBody(intRecBody) = dtDetail(intRow)(intRow2)
intRecBody += 1
Next
.Range(.Cells(intStartHeaderRow, intStartHeaderColumn), .Cells(intStartHeaderRow, intStartHeaderColumn + intRecBody)).Value2 = aryBody
.Range(.Cells(intStartHeaderRow, intStartHeaderColumn), .Cells(intStartHeaderRow, intStartHeaderColumn + intRecBody - 1)).BorderAround(LineStyle:=Excel.XlLineStyle.xlContinuous)
.Range(.Cells(intStartHeaderRow, intStartHeaderColumn), .Cells(intStartHeaderRow, intStartHeaderColumn + intRecBody)).WrapText = True
.Range(.Cells(intStartHeaderRow, intStartHeaderColumn), .Cells(intStartHeaderRow, intStartHeaderColumn + intRecBody)).Font.Size = 8
For intStyle = 1 To intRecBody
.Range(.Cells(intStartHeaderRow, intStyle), .Cells(intStartHeaderRow, intStyle)).BorderAround(LineStyle:=Excel.XlLineStyle.xlContinuous)
Next
Next
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
End With
Catch ex As Exception
Throw
End Try
xExcelApp.WindowState = Excel.XlWindowState.xlMaximized
xExcelApp.Visible = True
Else
Throw New ArgumentException("No record.")
End If
Return True
Catch ex As Exception
Throw
End Try
End Function
The above code is directly export the datatable to excel. But what I want to amend is export the datatable to xml first before export to excel. And the above code is static export to microsoft excel. Is there possibilities that after export to xml, system will check what kind of excel application installed so that can dynamically display in that excel application?
-
August 2nd, 2012, 03:59 AM
#2
Re: Datatable convert to xml and export to excel
 Originally Posted by daniel50096230
Is there possibilities that after export to xml, system will check what kind of excel application installed so that can dynamically display in that excel application?
Various ways 
You could have a look through the registry, to first determine if Office is indeed installed, and then look further to see what version. I'll give you that last part as homework 
This :
Code:
Imports Microsoft.Win32 'For registry functions
Public Class Form1
Public Function OfficeInstalled(ByVal App As String)
Dim strSubKey As String 'Find key
Select Case App 'What are we looking for?
Case "EXCEL" 'Excel
strSubKey = "Excel.Application"
End Select
Dim objOffKey As RegistryKey = Registry.ClassesRoot 'Try to find it
Dim objOffSubKey As RegistryKey = objOffKey.OpenSubKey("Excel.Application") 'FOund?
Return Not objOffSubKey Is Nothing
objOffKey.Close()
End Function
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
If OfficeInstalled("EXCEL") Then 'If found in regsitry
MessageBox.Show("Excel is Installed")
End If
End Sub
End Class
Determines if Office is installed on the machine.
Another way is to see if you can link to the Excel Object library, and then determine the version from there. You need to add a Reference to the Excel xx Object Library, on the Com tab. Then you could do something like this to identify which version of Excel has been installed :
Code:
Imports Microsoft.Office.Interop 'Office stuff
Public Class Form1
Inherits System.Windows.Forms.Form
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Dim oEApp As Excel.Application 'Excel object
Dim sEVersion As String 'To identify version
oEApp = DirectCast(CreateObject("Excel.Application"), Excel.Application) 'Cast to Excel app
Select Case oEApp.Version 'Determine version
Case "7.0"
sEVersion = "95"
Case "8.0"
sEVersion = "97"
Case "9.0"
sEVersion = "2000"
Case "10.0"
sEVersion = "2002"
Case "11.0"
sEVersion = "2003"
Case "12.0"
sEVersion = "2007"
Case "14.0"
sEVersion = "2010"
End Select
MessageBox.Show("Excel Version: " & sEVersion)
oEApp.Quit() 'quit
oEApp = Nothing
End Sub
End Class
This should give you enough to play around with. I hope it helps!
Hannes
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|
Reply With Quote
