Public Sub CommanAutoRunProcess(ByVal IsVisibleExcel As Boolean, Optional ByVal NoofWorkSheet As Integer = 1)
CreateNewInstance_Excel(IsVisibleExcel)
AddNewWorkbook()
AddNewWorkSheet("ABC", 1, NoofWorkSheet)
End Sub
'''
''' To Create a New Instance of Excel File Objects.
'''
''' Its Optional to Display the Excel File.
''' Its Optional to create more the one new Instance.
Public Sub CreateNewInstance_Excel(Optional ByVal IsVisibleFile As Boolean = False, Optional ByVal IsCreateMultipleInstance As Boolean = False)
If IsCreateMultipleInstance = True Then
xlsApplication = CreateObject("Excel.application")
Else
On Error Resume Next
xlsApplication = GetObject(, "Excel.Application")
If Err.Number = 429 Then
xlsApplication = CreateObject("Excel.application")
End If
End If
IsVisibleExcel(IsVisibleFile)
End Sub
'''
''' To Remove All Instance
'''
''' If the Excel File is Visible. Want to Display Excel file.
''' Kill All MS Excel Instances.
'''
Public Sub RemoveInstance(Optional ByVal IsVisibleFile As Boolean = False, Optional ByVal IsKillAllExcels As Boolean = False)
IsVisibleExcel(IsVisibleFile)
xlsWorkbook.Close()
xlsApplication.Quit()
xlsApplication = Nothing
xlsWorkbook = Nothing
xlsSheet = Nothing
If IsKillAllExcels = True Then
KillAllExcels()
End If
End Sub
'''
''' To Create a New WorkBook if instance of Application object is Exists.
'''
'''
Public Sub AddNewWorkbook()
If Not xlsApplication Is Nothing Then
xlsWorkbook = xlsApplication.Workbooks.Add
End If
End Sub
'''
''' To Create a New WorkSheet if instance of WorkBook object is Exists.
''' But one of than parameter(s) are mandatory.
'''
''' [Optional]Write the name of WorkSheet.
''' [Optional]Active WorkSheet item Number. Which Excel sheet you want to Process
''' [Optional]How many Sheet you want add in WorkBook. Default is 1 Sheet.
'''
Public Sub AddNewWorkSheet(Optional ByVal WorkSheetName As String = "", Optional ByVal WorkSheetNumber As Integer = -1, Optional ByVal NoOfSheetsAdd As Int16 = 1)
If Not xlsWorkbook Is Nothing Then
xlsSheet = xlsWorkbook.Worksheets.Add(, , NoOfSheetsAdd)
If Trim$(WorkSheetName) <> "" Then
xlsSheet.Name = Trim$(WorkSheetName)
xlsSheet = xlsWorkbook.Worksheets(Trim$(WorkSheetName))
ElseIf CInt(WorkSheetNumber) > 0 Then
xlsSheet = xlsWorkbook.Worksheets(CInt(WorkSheetNumber))
Else
xlsSheet = xlsWorkbook.Worksheets(1)
End If
End If
End Sub
Public Sub DeleteOldWorkSheet(Optional ByVal WorkSheetNumber As Integer = -1, Optional ByVal IsAllSheets As Boolean = False)
If xlsWorkbook Is Nothing And xlsSheet Is Nothing Then
Exit Sub
End If
If IsAllSheets = True Then
Dim i As Short
For i = 1 To xlsWorkbook.Worksheets.count
xlsSheet = xlsWorkbook.Worksheets(i).Delete
Next
Else
If WorkSheetNumber > 0 Then
xlsSheet = xlsWorkbook.Worksheets(WorkSheetNumber).Delete()
End If
End If
End Sub
'''
''' Save the Excel file.
'''
''' If IsAutoSave as True then give the Full path. if you don't, Microsoft Excel saves the file in the Default folder and if IsAutoSave is False then Only file name with extension. Display the Save as option.
''' True to file auto Save. and False no Action. Default is false
'''
'''
Public Function SaveFile(ByVal FilenameWithExt As String, Optional ByVal IsAutoSave As Boolean = False) As Boolean
Dim a
If xlsWorkbook Is Nothing And xlsApplication Is Nothing Then
SaveFile = False
Exit Function
End If
If IsAutoSave = False Then
a = xlsApplication.SaveWorkspace(FilenameWithExt)
If a Is Nothing Then
SaveFile = False
Else
SaveFile = True
End If
Else
'Activeworkbook.SaveAs Filename:="Nameoffile.xls", Fileformat:=xlnormal, Password:"xxxxx", Readonlyrecommended:False, CreateBackup=:False
xlsWorkbook.SaveAs(Filename:=FilenameWithExt, Fileformat:=1)
SaveFile = True
End If
End Function
'''
''' This is used for Merge Cells and format the data
'''
''' Text of Cell Value
''' Write the Range of Cells Which you want to Merge It. Example : A1:M1, B2:D4 etc
''' Set Horizontal Alignment in merge cells
''' [Optional] Font Name. By Default is Arial
''' [Optional] Font Size. By Default is 8
''' [Optional] Font Display as Bold. Default is False
''' [Optional] Font Display as Italic. Default is False
''' [Optional] Font Display as Color. Default is Black
''' [Optional] Cell back Color. Default is White
'''
Public Sub MergeCellUtility(ByVal CellValue As String _
, ByVal CellMergeRange As String, ByVal HAlgnment As amdHorizontalAlignment _
, Optional ByVal FontName As String = "Arial", Optional ByVal FontSize As Integer = 8 _
, Optional ByVal FontBold As Boolean = False, Optional ByVal FontItalic As Boolean = False, Optional ByVal FontColor As amdColors = amdColors.Black _
, Optional ByVal BackGroundColor As amdColors = amdColors.White)
With xlsApplication
.Range("" & CellMergeRange & "").Select()
.Selection.Merge()
.Selection.HorizontalAlignment = HAlgnment
End With
xlsSheet.Range("" & CellMergeRange & "").Value = CellValue
CellFontAndColorSetting(CellMergeRange, FontName, FontSize, FontBold, FontItalic, FontColor, BackGroundColor)
End Sub
'''
''' Write the Column Title.
'''
''' list of Header Name in Array
''' Column Number where to start the Values
''' Row Number where to start the Values
''' [Optional] Set Font Name. By Default is Arial
''' [Optional] Set Font Size. By Default is 10
''' [Optional] Set Font Display as Bold. Default is False
''' [Optional]Set Font Display as Italic. Default is False
''' [Optional] Set Font Display as Color. Default is Black
''' [Optional] Set Cell back Color. Default is White
''' [Optional] Set the Cell border line. Default is False
'''
Public Sub ExcelHeader(ByVal arrHeaderName() As String, ByVal ColumnStartNumber As Int32, ByVal CellRowNumber As Int32 _
, Optional ByVal FontName As String = "Arial", Optional ByVal FontSize As Integer = 10 _
, Optional ByVal FontBold As Boolean = False, Optional ByVal FontItalic As Boolean = False, Optional ByVal FontColor As amdColors = amdColors.Black _
, Optional ByVal BackGroundColor As amdColors = amdColors.White, Optional ByVal IsCellBorder As Boolean = True)
Dim intForcount As Int32
If Not arrHeaderName Is Nothing Then
HeaderColumnNumber = ColumnStartNumber
HeaderRowNumber = CellRowNumber + 1
For intForcount = LBound(arrHeaderName) To UBound(arrHeaderName) - 1 'Excluding First Column (i.e ID)
xlsSheet.Cells(CellRowNumber, ColumnStartNumber) = arrHeaderName(intForcount).ToString()
CellFontAndColorSetting(ColumnStartNumber, CellRowNumber, FontName, FontSize, FontBold, FontItalic, FontColor, BackGroundColor)
If IsCellBorder = True Then
CellBorderAndColorSetting(CellRowNumber, ColumnStartNumber, amdCellBroder.AllEdge, amdColors.Black, amdBorderline.amdThick1)
End If
ColumnStartNumber = ColumnStartNumber + 1
Next
End If
End Sub
'''
''' Write the Column Title.
'''
''' list of Header Name in DataTable
''' Column Number where to start the Values
''' Row Number where to start the Values
''' [Optional] Set Font Name. By Default is Arial
''' [Optional] Set Font Size. By Default is 10
''' [Optional] Set Font Display as Bold. Default is False
''' [Optional]Set Font Display as Italic. Default is False
''' [Optional] Set Font Display as Color. Default is Black
''' [Optional] Set Cell back Color. Default is White
''' [Optional] Set the Cell border line. Default is False
'''
Public Sub ExcelHeader(ByVal HeaderName As DataTable, ByVal ColumnStartNumber As Int32, ByVal RowStartNumber As Int32 _
, Optional ByVal FontName As String = "Arial", Optional ByVal FontSize As Integer = 10 _
, Optional ByVal FontBold As Boolean = False, Optional ByVal FontItalic As Boolean = False, Optional ByVal FontColor As amdColors = amdColors.Black _
, Optional ByVal BackGroundColor As amdColors = amdColors.White, Optional ByVal IsCellBorder As Boolean = True)
Dim intForcount As Int32
If HeaderName.Columns.Count > 0 Then
For intForcount = 1 To HeaderName.Columns.Count - 1
xlsSheet.Cells(RowStartNumber, ColumnStartNumber) = HeaderName.Columns(intForcount).ToString()
CellFontAndColorSetting(ColumnStartNumber, RowStartNumber, FontName, FontSize, FontBold, FontItalic, FontColor, BackGroundColor)
If IsCellBorder = True Then
CellBorderAndColorSetting(RowStartNumber, ColumnStartNumber, amdCellBroder.AllEdge, amdColors.Black, amdBorderline.amdThick1)
End If
ColumnStartNumber = ColumnStartNumber + 1
Next
End If
End Sub
Public Sub CellBorderAndColorSetting(ByVal RowCellNumber As Int16, ByVal ColumnCellNumber As Int16, ByVal BorderEdge As amdCellBroder _
, Optional ByVal FontColor As amdColors = amdColors.Black _
, Optional ByVal WeightBorderLine As amdBorderline = amdBorderline.amdThick2)
' xlsSheet.Cells(RowCellNumber, ColumnCellNumber).Select()
If BorderEdge = amdCellBroder.AllEdge Then
With xlsSheet.Cells(RowCellNumber, ColumnCellNumber)
With .BORDERS(amdCellBroder.TopEdge)
.LineStyle = 1 'xlContinuous = 1
.Weight = WeightBorderLine
.ColorIndex = FontColor
End With
End With
With xlsSheet.Cells(RowCellNumber, ColumnCellNumber)
With .BORDERS(amdCellBroder.LeftEdge)
.LineStyle = 1 'xlContinuous = 1
.Weight = WeightBorderLine
.ColorIndex = FontColor
End With
End With
With xlsSheet.Cells(RowCellNumber, ColumnCellNumber)
With .BORDERS(amdCellBroder.BottonEdge)
.LineStyle = 1 'xlContinuous = 1
.Weight = WeightBorderLine
.ColorIndex = FontColor
End With
End With
With xlsSheet.Cells(RowCellNumber, ColumnCellNumber)
With .BORDERS(amdCellBroder.RightEdge)
.LineStyle = 1 'xlContinuous = 1
.Weight = WeightBorderLine
.ColorIndex = FontColor
End With
End With
Else
With xlsSheet.Cells(RowCellNumber, ColumnCellNumber)
With .BORDERS(BorderEdge)
.LineStyle = 1 'xlContinuous = 1
.Weight = WeightBorderLine
.ColorIndex = FontColor
End With
End With
End If
End Sub
Public Sub CellBorderAndColorSetting(ByVal CellMergeRange As String, ByVal BorderEdge As amdCellBroder, _
Optional ByVal FontColor As amdColors = amdColors.Black _
, Optional ByVal WeightBorderLine As amdBorderline = amdBorderline.amdThick2)
xlsApplication.Range("" & CellMergeRange & "").Select()
If BorderEdge = amdCellBroder.AllEdge Then
With xlsSheet.RANGE("" & CellMergeRange & "")
With .BORDERS(amdCellBroder.TopEdge)
.LineStyle = 1 'xlContinuous = 1
.Weight = WeightBorderLine
.ColorIndex = FontColor
End With
End With
With xlsSheet.RANGE("" & CellMergeRange & "")
With .BORDERS(amdCellBroder.LeftEdge)
.LineStyle = 1 'xlContinuous = 1
.Weight = WeightBorderLine
.ColorIndex = FontColor
End With
End With
With xlsSheet.RANGE("" & CellMergeRange & "")
With .BORDERS(amdCellBroder.BottonEdge)
.LineStyle = 1 'xlContinuous = 1
.Weight = WeightBorderLine
.ColorIndex = FontColor
End With
End With
With xlsSheet.RANGE("" & CellMergeRange & "")
With .BORDERS(amdCellBroder.RightEdge)
.LineStyle = 1 'xlContinuous = 1
.Weight = WeightBorderLine
.ColorIndex = FontColor
End With
End With
Else
With xlsSheet.RANGE("" & CellMergeRange & "")
With .BORDERS(BorderEdge)
.LineStyle = 1 'xlContinuous = 1
.Weight = WeightBorderLine
.ColorIndex = FontColor
End With
End With
End If
End Sub
Public Sub CellFontAndColorSetting(ByVal CellMergeRange As String, Optional ByVal FontName As String = "Arial", Optional ByVal FontSize As Integer = 8 _
, Optional ByVal FontBold As Boolean = False, Optional ByVal FontItalic As Boolean = False, Optional ByVal FontColor As amdColors = amdColors.Black _
, Optional ByVal BackGroundColor As amdColors = amdColors.White)
With xlsApplication.Range("" & CellMergeRange & "")
With .Font()
.Name = FontName
.Size = FontSize
.Bold = FontBold
.Italic = FontItalic
.ColorIndex = FontColor
End With
.Interior.ColorIndex = BackGroundColor
End With
End Sub
Public Sub CellFontAndColorSetting(ByVal ColumnCellNumber As Int16, ByVal RowCellNumber As Int16, Optional ByVal FontName As String = "Arial", Optional ByVal FontSize As Integer = 8 _
, Optional ByVal FontBold As Boolean = False, Optional ByVal FontItalic As Boolean = False, Optional ByVal FontColor As amdColors = amdColors.Black _
, Optional ByVal BackGroundColor As amdColors = amdColors.White)
With xlsSheet.Cells(RowCellNumber, ColumnCellNumber)
.Select()
With .Font
.Name = FontName
.Size = FontSize
.Bold = FontBold
.Italic = FontItalic
.ColorIndex = FontColor
End With
.Interior.ColorIndex = BackGroundColor
End With
End Sub
Public Sub KillAllExcels()
Dim proc As System.Diagnostics.Process
For Each proc In System.Diagnostics.Process.GetProcessesByName("EXCEL")
proc.Kill()
Next
End Sub
Public Sub Addimage(ByVal imageFilePath As String, ByVal SheetNumber As Integer, ByVal CellNumber As String _
, Optional ByVal ImageHeight As Integer = -1, Optional ByVal ImageWidth As Integer = -1)
xlsSheet = xlsWorkbook.Worksheets(SheetNumber)
Dim opicture As Object
Dim objFso
objFso = CreateObject("Scripting.FileSystemObject")
If objFso.FileExists(imageFilePath) = True Then
opicture = xlsSheet.Pictures.Insert(imageFilePath)
With opicture
.select()
If ImageHeight > -1 Then
.height = ImageHeight
End If
If ImageWidth > -1 Then
.Width = ImageWidth
End If
.Top = xlsSheet.Range("" & CellNumber & "").Top
.Left = xlsSheet.Range("" & CellNumber & "").Left
End With
'opicture.ShapeRange.ScaleWidth(1.0, 0, 0)
'opicture.ShapeRange.ScaleHeight(1.0, 0, 0)
End If
objFso = Nothing
End Sub
Public Sub AddimageInHeaderFooter(ByVal HF_Enum As ImgPosition, ByVal a_Enum As ImgPositionAlign _
, ByVal SheetNumber As Integer, ByVal imageFilePath As String)
If HF_Enum = ImgPosition.PageHeader Then
If a_Enum = ImgPositionAlign.AlignCenter Then
xlsWorkbook.Worksheets(SheetNumber).PageSetup.CenterHeaderPicture.Filename = imageFilePath
xlsWorkbook.Worksheets(SheetNumber).PageSetup.CenterHeader = "&G"
ElseIf a_Enum = ImgPositionAlign.AlignLeft Then
xlsWorkbook.Worksheets(SheetNumber).PageSetup.LeftHeaderPicture.Filename = imageFilePath
xlsWorkbook.Worksheets(SheetNumber).PageSetup.LeftHeader = "&G"
ElseIf a_Enum = ImgPositionAlign.Alignright Then
xlsWorkbook.Worksheets(SheetNumber).PageSetup.RightHeaderPicture.Filename = imageFilePath
xlsWorkbook.Worksheets(SheetNumber).PageSetup.RightHeader = "&G"
End If
ElseIf HF_Enum = ImgPosition.PageFooter Then
If a_Enum = ImgPositionAlign.AlignCenter Then
xlsWorkbook.Worksheets(SheetNumber).PageSetup.CenterFooterPicture.Filename = imageFilePath
xlsWorkbook.Worksheets(SheetNumber).PageSetup.CenterFooter = "&G"
ElseIf a_Enum = ImgPositionAlign.AlignLeft Then
xlsWorkbook.Worksheets(SheetNumber).PageSetup.LeftFooterPicture.Filename = imageFilePath
xlsWorkbook.Worksheets(SheetNumber).PageSetup.LeftFooter = "&G"
ElseIf a_Enum = ImgPositionAlign.Alignright Then
xlsWorkbook.Worksheets(SheetNumber).PageSetup.RightFooterPicture.Filename = imageFilePath
xlsWorkbook.Worksheets(SheetNumber).PageSetup.RightFooter = "&G"
End If
End If
'Sub InsertPicture()
'With ActiveSheet.PageSetup.LeftFooterPicture
' .FileName = "C:\Sample.jpg"
' .Height = 275.25
' .Width = 463.5
' .Brightness = 0.36
' .ColorType = msoPictureGrayscale
' .Contrast = 0.39
' .CropBottom = -14.4
' .CropLeft = -28.8
' .CropRight = -14.4
' .CropTop = 21.6
'End With
'' Enable the image to show up in the left footer.
'ActiveSheet.PageSetup.LeftFooter = "&G"
End Sub
Public Sub Print()
With xlsWorkbook.Worksheets(1)
.PageSetup.Orientation = 1
.PrintOut()
End With
'With Worksheets(1).PageSetup
' .LeftMargin = Application.InchesToPoints(0.5)
' .RightMargin = Application.InchesToPoints(0.75)
' .TopMargin = Application.InchesToPoints(1.5)
' .BottomMargin = Application.InchesToPoints(1)
' .HeaderMargin = Application.InchesToPoints(0.5)
' .FooterMargin = Application.InchesToPoints(0.5)
'End With
End Sub
Public Sub FillData(ByVal value As String, ByVal StartRow As Integer, ByVal StartColumn As Integer, _
Optional ByVal IsColumnAutoFit As Boolean = False _
, Optional ByVal IsCellBorder As Boolean = False)
Dim i As Integer, j As Integer, k As Integer
If value <> "" Then
If StartRow > 0 Then
k = StartRow
End If
If StartColumn > 0 Then
j = StartColumn
End If
If StartRow < 1 And StartColumn < 1 Then
Exit Sub
End If
xlsSheet.Cells(k, j).Value = "'" & value
If IsColumnAutoFit = True Then
xlsSheet.Cells(k, j).EntireColumn.AutoFit()
End If
If IsCellBorder = True Then
CellBorderAndColorSetting(k, j, amdCellBroder.AllEdge, amdColors.Black, amdBorderline.amdThick1)
End If
End If
End Sub
Public Sub FillData(ByVal arrSetValue() As String, Optional ByVal StartRow As Integer = -1, Optional ByVal StartColumn As Integer = -1, _
Optional ByVal IsColumnAutoFit As Boolean = False _
, Optional ByVal IsCellBorder As Boolean = False)
Dim i As Integer, j As Integer, k As Integer
If Not arrSetValue Is Nothing Then
j = LBound(arrSetValue) + 1
k = HeaderRowNumber
For i = LBound(arrSetValue) To UBound(arrSetValue) - 1
xlsSheet.Cells(k, j).Value = "'" & arrSetValue(i)
If IsColumnAutoFit = True Then
xlsSheet.Cells(k, j).EntireColumn.AutoFit()
End If
If IsCellBorder = True Then
CellBorderAndColorSetting(k, j, amdCellBroder.AllEdge, amdColors.Black, amdBorderline.amdThick1)
End If
j += 1
Next
End If
End Sub
Public Sub FillData(ByVal arrSetValue(,) As String, Optional ByVal ColumnAutoFit As Boolean = False _
, Optional ByVal IsCellBorder As Boolean = False)
Dim i As Integer, j As Integer, k As Integer, l As Integer
If Not arrSetValue Is Nothing Then
l = LBound(arrSetValue, 2) + HeaderColumnNumber
k = HeaderRowNumber
For i = LBound(arrSetValue, 1) To UBound(arrSetValue, 1) ' For Row
For j = LBound(arrSetValue, 2) To UBound(arrSetValue, 2) - 1 ' For Column
xlsSheet.Cells(k, l).Value = "'" & arrSetValue(i, j)
If ColumnAutoFit = True Then
xlsSheet.Cells(k, l).EntireColumn.AutoFit()
End If
If IsCellBorder = True Then
CellBorderAndColorSetting(k, l, amdCellBroder.AllEdge, amdColors.Black, amdBorderline.amdThick1)
End If
l += 1
Next
k += 1
l = LBound(arrSetValue, 2) + HeaderColumnNumber
Next
End If
End Sub
Public Function FillData(ByVal dtSetValues As DataTable, Optional ByVal ColumnAutoFit As Boolean = False _
, Optional ByVal IsCellBorder As Boolean = False, Optional ByVal IsSerailNo As Boolean = False) As Integer
Dim i As Integer, j As Integer, k As Integer, l As Integer
If IsSerailNo = True Then
l = HeaderColumnNumber + 1
Else
l = HeaderColumnNumber
End If
k = 1
If dtSetValues.Rows.Count > 0 Then
For i = 0 To dtSetValues.Rows.Count.ToString() - 1
For j = 1 To dtSetValues.Columns.Count.ToString() - 1
xlsSheet.Cells(HeaderRowNumber, l).Value = "'" & dtSetValues.Rows(i)(j).ToString().Replace(vbCrLf, "")
If ColumnAutoFit = True Then
xlsSheet.Cells(HeaderRowNumber, l).EntireColumn.AutoFit()
End If
If IsCellBorder = True Then
CellBorderAndColorSetting(HeaderRowNumber, l, amdCellBroder.AllEdge, amdColors.Black, amdBorderline.amdThick1)
End If
l += 1
Next
If IsSerailNo = True Then
xlsSheet.Cells(HeaderRowNumber, HeaderColumnNumber).Value = "'" & k
CellBorderAndColorSetting(HeaderRowNumber, HeaderColumnNumber, amdCellBroder.AllEdge, amdColors.Black, amdBorderline.amdThick1)
k = k + 1
l = HeaderColumnNumber + 1
Else
l = HeaderColumnNumber
End If
HeaderRowNumber += 1
Next
FillData = HeaderRowNumber
End If
End Function
Public Sub IsVisibleExcel(ByVal IsValue As Boolean)
xlsApplication.Visible = IsValue
End Sub
Public Sub ColumnSize(ByVal CellRange As String, Optional ByVal width As Integer = -1, Optional ByVal height As Integer = -1)
With xlsApplication
.Columns("" & CellRange & "").ColumnWidth = width
End With
End Sub
Public Sub TextWrapInCell(ByVal value As Boolean, ByVal CellRange As String)
'ExcelSheet.Range(ExcelSheet.Cells(6, 1), ExcelSheet.Cells(9, 6)).WrapText = True
xlsSheet.Cells.Range("" & CellRange & "").WrapText = value
End Sub
Public Sub TextAutofitInCell(ByVal value As Boolean, ByVal CellRange As String)
' ExcelSheet.Cells.Range("B" & row & ":F" & columns).EntireColumn.AutoFit()
xlsSheet.Cells.Range("" & CellRange & "").EntireColumn.AutoFit()
End Sub
End Module
No comments:
Post a Comment