Last active
October 4, 2019 07:47
-
-
Save Laicure/c7c90a0a76c0c03f8c6fa34c393803a3 to your computer and use it in GitHub Desktop.
Revisions
-
Laicure revised this gist
Oct 4, 2019 . 1 changed file with 15 additions and 15 deletions.There are no files selected for viewing
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode charactersOriginal file line number Diff line number Diff line change @@ -3,7 +3,7 @@ Module UnModulatedX #Region "Export To Excel" Friend Sub Exporter(ByVal ExportName As String, dtFirst As DataTable, dtSecond As DataTable, firstSheetName As String, sencondSheetName As String) 'init Dim excel As Object = CreateObject("Excel.Application") Dim wBook As New Object @@ -23,16 +23,16 @@ Module UnModulatedX Dim dr As DataRow Dim colIndex As Integer = 0 For Each dc As DataColumn In dtFirst.Columns colIndex += 1 excel.Cells(1, colIndex) = dc.ColumnName Next Dim arrX(dtFirst.Rows.Count, dtFirst.Columns.Count) As Object For r As Integer = 0 To dtFirst.Rows.Count - 1 dr = dtFirst.Rows(r) For c As Integer = 0 To dtFirst.Columns.Count - 1 If IsDBNull(dr(c)) = False Then If IsNumeric(dr(c)) = True Then arrX(r, c) = dr(c) @@ -46,28 +46,28 @@ Module UnModulatedX Next Dim c1 As Object = wSheet.Cells(2, 1) Dim c2 As Object = wSheet.Cells(1 + dtFirst.Rows.Count, dtFirst.Columns.Count) Dim Rr As Object = wSheet.Range(c1, c2) Rr.Value2 = arrX 'first shit If dtSecond.Rows.Count > 0 Then Dim wSheet2 As Object wSheet2 = wBook.Worksheets.add(wSheet, , , ) wSheet2.Name = firstSheetName Dim drr As DataRow Dim colIndexx As Integer = 0 For Each dc As DataColumn In dtSecond.Columns colIndexx += 1 excel.Cells(1, colIndexx) = dc.ColumnName Next Dim arrXx(dtSecond.Rows.Count, dtSecond.Columns.Count) As Object For r As Integer = 0 To dtSecond.Rows.Count - 1 drr = dtSecond.Rows(r) For c As Integer = 0 To dtSecond.Columns.Count - 1 'formatting checks If IsDBNull(drr(c)) = False Then If IsNumeric(drr(c)) = True Then @@ -82,7 +82,7 @@ Module UnModulatedX Next Dim c11 As Object = wSheet2.Cells(2, 1) Dim c22 As Object = wSheet2.Cells(1 + dtSecond.Rows.Count, dtSecond.Columns.Count) Dim Rrr As Object = wSheet2.Range(c11, c22) Rrr.Value2 = arrXx End If @@ -103,7 +103,7 @@ Module UnModulatedX Runtime.InteropServices.Marshal.ReleaseComObject(wSheet) GC.Collect() End Sub #End Region #Region "Read Excel" -
Oct 4, 2019 . 1 changed file with 24 additions and 91 deletions.There are no files selected for viewing
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode charactersOriginal file line number Diff line number Diff line change @@ -3,15 +3,12 @@ Module UnModulatedX #Region "Export To Excel" Friend Sub Exporter(ByVal ExportName As String, dtX As DataTable, dtY As DataTable, firstSheetName As String, sencondSheetName As String) 'init Dim excel As Object = CreateObject("Excel.Application") Dim wBook As New Object Dim wSheet As New Object With excel .EnableEvents = False .ScreenUpdating = False @@ -20,63 +17,22 @@ Module UnModulatedX wBook = excel.Workbooks.Add 'second shit wSheet = wBook.ActiveSheet wSheet.Name = sencondSheetName Dim dr As DataRow Dim colIndex As Integer = 0 For Each dc As DataColumn In dtX.Columns colIndex += 1 excel.Cells(1, colIndex) = dc.ColumnName Next Dim arrX(dtX.Rows.Count, dtX.Columns.Count) As Object For r As Integer = 0 To dtX.Rows.Count - 1 dr = dtX.Rows(r) For c As Integer = 0 To dtX.Columns.Count - 1 If IsDBNull(dr(c)) = False Then If IsNumeric(dr(c)) = True Then arrX(r, c) = dr(c) @@ -90,50 +46,28 @@ Module UnModulatedX Next Dim c1 As Object = wSheet.Cells(2, 1) Dim c2 As Object = wSheet.Cells(1 + dtX.Rows.Count, dtX.Columns.Count) Dim Rr As Object = wSheet.Range(c1, c2) Rr.Value2 = arrX 'first shit If dtY.Rows.Count > 0 Then Dim wSheet2 As Object wSheet2 = wBook.Worksheets.add(wSheet, , , ) wSheet2.Name = firstSheetName Dim drr As DataRow Dim colIndexx As Integer = 0 For Each dc As DataColumn In dtY.Columns colIndexx += 1 excel.Cells(1, colIndexx) = dc.ColumnName Next Dim arrXx(dtY.Rows.Count, dtY.Columns.Count) As Object For r As Integer = 0 To dtY.Rows.Count - 1 drr = dtY.Rows(r) For c As Integer = 0 To dtY.Columns.Count - 1 'formatting checks If IsDBNull(drr(c)) = False Then If IsNumeric(drr(c)) = True Then @@ -148,10 +82,9 @@ Module UnModulatedX Next Dim c11 As Object = wSheet2.Cells(2, 1) Dim c22 As Object = wSheet2.Cells(1 + dtY.Rows.Count, dtY.Columns.Count) Dim Rrr As Object = wSheet2.Range(c11, c22) Rrr.Value2 = arrXx End If With excel @@ -160,9 +93,9 @@ Module UnModulatedX .DisplayAlerts = True End With wBook.SaveAs(ExportName & ".xlsb", 50) wBook.Close(False, Nothing, Nothing) excel.Quit() Runtime.InteropServices.Marshal.ReleaseComObject(excel) -
Jan 30, 2018 . 1 changed file with 183 additions and 41 deletions.There are no files selected for viewing
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode charactersOriginal file line number Diff line number Diff line change @@ -4,48 +4,84 @@ Module UnModulatedX #Region "Export To Excel" '********** Export to Excel Friend Sub Exporter(ByVal ExportName As String, dtxx As DataTable, dtyy As DataTable) 'init Dim excel As New Object Dim wBook As New Object Dim wSheet As New Object excel = CreateObject("Excel.Application") With excel .EnableEvents = False .ScreenUpdating = False .DisplayAlerts = False End With wBook = excel.Workbooks.Add 'first shit wSheet = wBook.ActiveSheet wSheet.Name = "<SheetName>" Dim dr As DataRow Dim colIndex As Integer = 0 For Each dc As DataColumn In dtxx.Columns colIndex = colIndex + 1 excel.Cells(1, colIndex) = dc.ColumnName Next Dim arrX(dtxx.Rows.Count, dtxx.Columns.Count) As Object 'view formatting With wSheet .Columns(1).NumberFormat = "General" .Columns(2).NumberFormat = "0" .Columns(3).NumberFormat = "General" .Columns(4).NumberFormat = "General" .Columns(5).NumberFormat = "General" .Columns(6).NumberFormat = "General" .Columns(7).NumberFormat = "0" .Columns(8).NumberFormat = "0" .Columns(9).NumberFormat = "mm/dd/yyyy" .Columns(10).NumberFormat = "mm/dd/yyyy" .Columns(11).NumberFormat = "General" .Columns(12).NumberFormat = "mm/dd/yyyy" .Columns(13).NumberFormat = "mm/dd/yyyy" .Columns(14).NumberFormat = "General" .Columns(15).NumberFormat = "General" .Columns(16).NumberFormat = "dddd, mmmm dd, yyyy" .Columns(17).NumberFormat = "mm/dd/yyyy" .Columns(18).NumberFormat = "_-[$$-en-US]* #,##0.00_ ;_-[$$-en-US]* -#,##0.00 ;_-[$$-en-US]* ""-""??_ ;_-General_ " .Columns(19).NumberFormat = "#,##0.00" .Columns(20).NumberFormat = "General" .Columns(21).NumberFormat = "0" .Columns(22).NumberFormat = "General" .Columns(23).NumberFormat = "General" .Columns(24).NumberFormat = "General" .Columns(25).NumberFormat = "0" .Columns(26).NumberFormat = "0" .Columns(27).NumberFormat = "0" .Columns(28).NumberFormat = "General" .Columns(29).NumberFormat = "General" .Columns(30).NumberFormat = "mm/dd/yyyy" .Columns(31).NumberFormat = "dddd, mmmm dd, yyyy" .Columns(32).NumberFormat = "General" .Columns(33).NumberFormat = "mm/dd/yyyy" .Columns(34).NumberFormat = "General" .Columns(35).NumberFormat = "General" .Columns(36).NumberFormat = "General" .Columns(37).NumberFormat = "General" .Columns(38).NumberFormat = "General" End With For r As Integer = 0 To dtxx.Rows.Count - 1 dr = dtxx.Rows(r) For c As Integer = 0 To dtxx.Columns.Count - 1 If IsDBNull(dr(c)) = False Then If IsNumeric(dr(c)) = True Then arrX(r, c) = dr(c) Else arrX(r, c) = Trim(dr(c).ToString) End If Else arrX(r, c) = "" @@ -54,32 +90,138 @@ Module UnModulatedX Next Dim c1 As Object = wSheet.Cells(2, 1) Dim c2 As Object = wSheet.Cells(1 + dtxx.Rows.Count, dtxx.Columns.Count) Dim Rr As Object = wSheet.Range(c1, c2) Rr.Value2 = arrX wSheet.Columns.AutoFit() 'second shit If dtyy.Rows.Count > 0 Then Dim wSheet2 As Object wSheet2 = wBook.Worksheets.add(wSheet, , , ) wSheet2.Name = "Checklist" Dim drr As DataRow Dim colIndexx As Integer = 0 For Each dc As DataColumn In dtyy.Columns colIndexx = colIndexx + 1 excel.Cells(1, colIndexx) = dc.ColumnName Next Dim arrXx(dtyy.Rows.Count, dtyy.Columns.Count) As Object 'view formatting With wSheet2 .Columns(1).NumberFormat = "General" .Columns(2).NumberFormat = "0" .Columns(3).NumberFormat = "0" .Columns(4).NumberFormat = "General" .Columns(5).NumberFormat = "0" .Columns(6).NumberFormat = "General" .Columns(7).NumberFormat = "General" .Columns(8).NumberFormat = "0" .Columns(9).NumberFormat = "_-[$$-en-US]* #,##0.00_ ;_-[$$-en-US]* -#,##0.00 ;_-[$$-en-US]* ""-""??_ ;_-General_ " .Columns(10).NumberFormat = "#,##0.00" .Columns(11).NumberFormat = "General" .Columns(12).NumberFormat = "General" .Columns(13).NumberFormat = "General" .Columns(14).NumberFormat = "General" .Columns(15).NumberFormat = "General" .Columns(16).NumberFormat = "General" .Columns(17).NumberFormat = "General" .Columns(18).NumberFormat = "mm/dd/yyyy" End With For r As Integer = 0 To dtyy.Rows.Count - 1 drr = dtyy.Rows(r) For c As Integer = 0 To dtyy.Columns.Count - 1 'formatting checks If IsDBNull(drr(c)) = False Then If IsNumeric(drr(c)) = True Then arrXx(r, c) = drr(c) Else arrXx(r, c) = Trim(drr(c).ToString) End If Else arrXx(r, c) = "" End If Next Next Dim c11 As Object = wSheet2.Cells(2, 1) Dim c22 As Object = wSheet2.Cells(1 + dtyy.Rows.Count, dtyy.Columns.Count) Dim Rrr As Object = wSheet2.Range(c11, c22) Rrr.Value2 = arrXx wSheet2.Columns.AutoFit() End If With excel .EnableEvents = True .ScreenUpdating = True .DisplayAlerts = True End With wBook.SaveAs(ExportName & ".xlsx") wBook.Close() excel.Quit() Runtime.InteropServices.Marshal.ReleaseComObject(excel) Runtime.InteropServices.Marshal.ReleaseComObject(wBook) Runtime.InteropServices.Marshal.ReleaseComObject(wSheet) GC.Collect() End Sub #End Region #Region "Read Excel" Friend Function ReadExcel(ByVal FilePath As String) As Data.DataTable Dim excelData As New Data.DataTable Dim excel As New Object Dim wBook As New Object Dim wSheet As New Object excel = CreateObject("Excel.Application") Try wBook = excel.Workbooks.Open(FilePath) wSheet = wBook.Worksheets("<SheetName>") Catch ex As Exception wBook.Close() excel.Quit() Runtime.InteropServices.Marshal.ReleaseComObject(excel) Runtime.InteropServices.Marshal.ReleaseComObject(wBook) Return Nothing Exit Function End Try 'get row count Dim RowCount As Integer = wSheet.UsedRange.Rows.Count Dim ColCount As Integer = wSheet.UsedRange.Columns.Count 'to Datatable For colx As Integer = 1 To ColCount excelData.Columns.Add(wSheet.Cells(1, colx).value) Next For rowx As Integer = 2 To RowCount Step 1 Dim rdr As Data.DataRow = excelData.NewRow For colx As Integer = 1 To ColCount Step 1 rdr(colx - 1) = wSheet.Cells(rowx, colx).value Next excelData.Rows.Add(rdr) Next wBook.Close() excel.Quit() Runtime.InteropServices.Marshal.ReleaseComObject(excel) Runtime.InteropServices.Marshal.ReleaseComObject(wBook) Runtime.InteropServices.Marshal.ReleaseComObject(wSheet) GC.Collect() Return excelData End Function #End Region End Module -
Nov 17, 2017 . 1 changed file with 6 additions and 6 deletions.There are no files selected for viewing
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode charactersOriginal file line number Diff line number Diff line change @@ -4,14 +4,14 @@ Module UnModulatedX #Region "Export To Excel" '********** Export to Excel Friend Sub Exporter(ByRef ExportName As String, ByRef dtxx As Data.DataTable) Dim dataTableXTemp As New Data.DataTable dataTableXTemp = dtxx.Copy Dim excel As New Object Dim wBook As Object Dim wSheet As Object Dim dc As Data.DataColumn excel = CreateObject("Excel.Application") @@ -37,14 +37,14 @@ Module UnModulatedX For r As Integer = 0 To dataTableXTemp.Rows.Count - 1 dr = dataTableXTemp.Rows(r) For c As Integer = 0 To dataTableXTemp.Columns.Count - 1 If Not IsDBNull(dr(c)) Then If dr(c).GetType = GetType(Date) Then arrX(r, c) = Format(dr(c), "yyyy-MM-dd HH:mm:ss.fff").ToString Else If IsNumeric(dr(c)) = True Then arrX(r, c) = dr(c) Else arrX(r, c) = dr(c).ToString.Replace(vbCrLf, " ").Replace(vbCr, " ").Replace(vbLf, " ").Replace(vbTab, " ") End If End If Else -
Jul 27, 2017 .There are no files selected for viewing
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode charactersOriginal file line number Diff line number Diff line change @@ -0,0 +1,85 @@ Option Strict Off Module UnModulatedX #Region "Export To Excel" '********** Export to Excel Friend Sub Exporter(ByVal ExportName As String, timeout As Integer, connection As String, dtxx As DataTable) Dim dataTableXTemp As New DataTable dataTableXTemp = dtxx.Copy Dim excel As New Object Dim wBook As Object Dim wSheet As Object Dim dc As DataColumn excel = CreateObject("Excel.Application") excel.EnableEvents = False excel.ScreenUpdating = False excel.DisplayAlerts = False wBook = excel.Workbooks.Add wSheet = wBook.ActiveSheet Dim dr As System.Data.DataRow Dim colIndex As Integer = 0 For Each dc In dataTableXTemp.Columns colIndex = colIndex + 1 excel.Cells(1, colIndex) = dc.ColumnName Next Dim arrX(dataTableXTemp.Rows.Count, dataTableXTemp.Columns.Count) As Object wSheet.Columns.NumberFormat = "@" For r As Integer = 0 To dataTableXTemp.Rows.Count - 1 dr = dataTableXTemp.Rows(r) For c As Integer = 0 To dataTableXTemp.Columns.Count - 1 If IsDBNull(dr(c)) = False Then If dr(c).GetType = GetType(Date) Then arrX(r, c) = Format(dr(c), "yyyy-MM-dd").ToString Else If IsNumeric(dr(c)) = True Then arrX(r, c) = dr(c) Else arrX(r, c) = Trim(dr(c).ToString) End If End If Else arrX(r, c) = "" End If Next Next Dim c1 As Object = wSheet.Cells(2, 1) Dim c2 As Object = wSheet.Cells(1 + dataTableXTemp.Rows.Count, dataTableXTemp.Columns.Count) Dim Rr As Object = wSheet.Range(c1, c2) Rr.Value2 = arrX excel.EnableEvents = True excel.ScreenUpdating = True excel.DisplayAlerts = True wSheet.Columns.AutoFit() wBook.SaveAs(ExportName & ".xlsx") wBook.Close() excel.Quit() releaseObject(excel) releaseObject(wBook) releaseObject(wSheet) End Sub Friend Sub releaseObject(ByVal obj As Object) Runtime.InteropServices.Marshal.ReleaseComObject(obj) End Sub #End Region End Module