1- Super key - Any Unique key with some Non Unique key combination is called a super key of the relationship.
Example :
+----------+----------+----------+
Roll Number First Name Last Name
+----------+----------+----------+
CSU0001 Shabbir Bhimani
CSU0002 SomeName SurName
CSU0003 Larry page
+------+-----+----------+
Now here we have the following as super keysa). Roll Number First Nameb). Roll Number First Name Last Name
2- Unique key - Unique key contain No duplicate data and one NULL value in a attribute (column).
3- Candidate key - More than one column carry unique values across the table is said to a candidate key. One of those key column becomes Primary key and other column become alternate key.
Example :
+-----------+-----------+---------+-----------+
Roll Number First Name Last Name student_id
+-----------+----------+-----------+----------+
CSU0001 Shabbir Bhimani 212
CSU0002 SomeName SurName 260
CSU0003 Larry page 300
+--------+-----+----+----------------+
Now, RollNumber and student_id is not null unique values so both are candidate key. if one is choice a Primary key i.e. roll number other column (Student_id) become a alternate key.
4- Primary key -
5- Alternate key
6- Composite key - combination of two or more column is called as compite key.Example :
CREATE TABLE Authors (AuthorID INT NOT NULL,Name VARCHAR(100) NOT NULL,PRIMARY KEY(AuthorID,Name))
7- Foreign Key -
What's the difference between a primary key and a unique key?
Both primary key and unique enforce uniqueness of the column on which they are defined. But by default primary key creates a clustered index on the column, where are unique creates a
nonclustered index by default. Another major difference is that, primary key doesn't allow NULLs, but unique key allows one NULL only.
November 6, 2009
October 28, 2009
Sql Server: Unique Constraint with Example
Unique Constraints to make sure that no duplicate values are entered in specific columns and UNIQUE constraints allow single value NULL in specific column. By default its create NonCluster index.
Add Unique constraint:
1- After Created Table
ALTER TABLE <>ADD CONSTRAINT <>UNIQUE( <>)
2- At the Time of table creation
A) in column level
create table <>
(
<> datatype ,
<> datatype unique
)
Example :
CREATE TABLE Emp ( Empid int primary key, Empcode int unique )
b) In Table Level
create table <> (
<> datatype , <> datatype
CONSTRAINT <> unique( <>)
)
Example :
CREATE TABLE Emp
(
Empid int primary key, Empcode int
CONSTRAINT UQ_INEmpCOde unique(Empcode)
)
Drop Constraints:
ALTER TABLE <> DROP CONSTRAINT < Constraint Name
Example:
Alter table emp
drop constraint UQ_INEmpCOde
Add Unique constraint:
1- After Created Table
ALTER TABLE <>ADD CONSTRAINT <>UNIQUE( <>)
2- At the Time of table creation
A) in column level
create table <>
(
<> datatype ,
<> datatype unique
)
Example :
CREATE TABLE Emp ( Empid int primary key, Empcode int unique )
b) In Table Level
create table <> (
<> datatype , <> datatype
CONSTRAINT <> unique( <>)
)
Example :
CREATE TABLE Emp
(
Empid int primary key, Empcode int
CONSTRAINT UQ_INEmpCOde unique(Empcode)
)
Drop Constraints:
ALTER TABLE <> DROP CONSTRAINT < Constraint Name
Example:
Alter table emp
drop constraint UQ_INEmpCOde
October 26, 2009
Sql Server: Reset identity Value.
dbcc checkident([tableName],reseed/NORESEED,[Reset_Start_Vaue])
Parameter Description :
- NORESEED Returns the current identity value and the current maximum value of the identity column, without reseeding. These values are usually (and should be) the same.
- RESEED Changes the current identity value, using the maximum value in the identity column, if the current identity value is less than the maximum identity value stored in the identity column.
- newreseedvalue Specifies the new seed value when reseeding. If the table is empty, the first identity value (after executing DBCC CHECKIDENT) will equal newreseedvalue. If the table contains data, the next identity value will equal newreseedvalue + the current increment value (the default is 1). This behavior is new to SQL Server 2005 (and remains in 2008). SQL Server 2000 always increments the seed value.
- WITH NO INFOMSGS Suppresses all informational messages.
Example:
dbcc checkident('tblDetails',reseed,0)
October 21, 2009
Sql Server : Shrink Database
-- Sql Server 2000
1 -
dbcc shrinkfile(dbName_log,1)
Go
2 -
BACKUP LOG dbName WITH TRUNCATE_ONLY
Go
3 -
select * from sysfiles
OR
-- File sixe in MB.
SELECT name, size*8192/(1024*1024) AS sizeInMB , * FROM sysfiles
--- Sql Server 2008
Alter Database Test Set Recovery Simple
GO
Alter Database Test Set Recovery Full
GO
DBCC SHRINKFILE ('Test_log', 1)
GO
Note: Test is a database name.
1 -
dbcc shrinkfile(dbName_log,1)
Go
2 -
BACKUP LOG dbName WITH TRUNCATE_ONLY
Go
3 -
select * from sysfiles
OR
-- File sixe in MB.
SELECT name, size*8192/(1024*1024) AS sizeInMB , * FROM sysfiles
--- Sql Server 2008
Alter Database Test Set Recovery Simple
GO
Alter Database Test Set Recovery Full
GO
DBCC SHRINKFILE ('Test_log', 1)
GO
Note: Test is a database name.
Sql Server : Numeric Datatype
- tinyint Allow Integer data from 0 – 255.
- smallint Allows whole numbers between -32,768 and 32,767 or from -2^15 through 2^15 - 1
- int Allows whole numbers between -2,147,483,648 and 2,147,483,647 or from -2^31 through 2^31 - 1
- bigint Allows whole numbers between -9,223,372,036,854,775,808 and 9,223,372,036,854,775,807 or from -2^63 through 2^63-1
October 7, 2009
Sql Server: Add & delete identity in existing table and column
************ Drop identity *******************
update syscolumns
set colstat =0
where id = object_id('tbl1') and name = 'rowid1'
Explanation:
tbl1 is a table name
rowid1 is a column name
if colstat = 0 means drop identity in a column
************ ADD identity IN EXISTING column *******************
Step 1:
update syscolumns
set colstat = 1
where id = object_id('tbl1') and name = 'rowid1'
Step 2: If data already exists in table and column is primary key use is
DBCC CHECKIDENT ('tbl1', RESEED,XX)
Explanation:
xx is a last column value + 1 as int.
tbl1 is a table name
rowid1 is a column name
if colstat = 1 means add identity in a column
update syscolumns
set colstat =0
where id = object_id('tbl1') and name = 'rowid1'
Explanation:
tbl1 is a table name
rowid1 is a column name
if colstat = 0 means drop identity in a column
************ ADD identity IN EXISTING column *******************
Step 1:
update syscolumns
set colstat = 1
where id = object_id('tbl1') and name = 'rowid1'
Step 2: If data already exists in table and column is primary key use is
DBCC CHECKIDENT ('tbl1', RESEED,XX)
Explanation:
xx is a last column value + 1 as int.
tbl1 is a table name
rowid1 is a column name
if colstat = 1 means add identity in a column
Sql Server: set DEFAULT constraint value after table creation
DEFAULT CONSTRAINTS:
DEFAULT constraints allow you to specify a value that the database will use to populate fields that are left blank in the input source.
ALTER ATBLE [Table Name]
ADD CONSTRAINT [Constraint Name] DEFAULT [Default Value] FOR [Column Name]
Example:
Alter table tblabc
ADD CONSTRAINT c_default default getdate() for inDateTime
DEFAULT constraints allow you to specify a value that the database will use to populate fields that are left blank in the input source.
ALTER ATBLE [Table Name]
ADD CONSTRAINT [Constraint Name] DEFAULT [Default Value] FOR [Column Name]
Example:
Alter table tblabc
ADD CONSTRAINT c_default default getdate() for inDateTime
August 27, 2009
SQL Server: String (character) datatype
Non-Unicode
Unicode
- char(n) : Fixed-length string with Maximum 8,000 characters
- varchar(n) : Variable-length string with Maximum 8,000 characters
- varchar(max) : Variable-length string with Maximum 1,073,741,824 characters
- Text : Variable-length string with Maximum 2GB of text data or maximum length of 2^31 - 1 characters
Unicode
- nchar(n) : Fixed-length Unicode data with Maximum 4,000 characters.
- nvarchar(n) : Variable-length Unicode data with Maximum 4,000 characters.
- nvarchar(max): Variable-length Unicode data with Maximum 536,870,912 characters.
- ntext : Variable-length Unicode data. Maximum 2GB of text data or a maximum length of 2^30 - 1 characters
August 20, 2009
Sql Server : Change Column & Table Name
Change Column Name :-
sp_RENAME 'TableName.OldColumnName', 'NewColumnName' , 'COLUMN'
Example:
'TableName.OldColumnName' Variables
'NewColumnName' Variables
'COLUMN' is Fixed value.
Change Table Name :-
sp_RENAME 'oldTableName, 'NewTableName'
sp_RENAME 'TableName.OldColumnName', 'NewColumnName' , 'COLUMN'
Example:
'TableName.OldColumnName' Variables
'NewColumnName' Variables
'COLUMN' is Fixed value.
Change Table Name :-
sp_RENAME 'oldTableName, 'NewTableName'
August 19, 2009
VB 6.0: Write/Append log in text file
Public Sub ErrorInFile(ModuleName As String, FunctionName As String, ErrorDesc As String)
Dim iFileNumberWrite As Integer, str As String
iFileNumberWrite = FreeFile
str = ""
str = str & "On DateTime : " & Format(Now, "dd-MMM-yyyy HH:mm:ss") & vbCrLf
str = str & "Module Name : " & ModuleName & vbCrLf
str = str & "Function Name : " & FunctionName & vbCrLf
str = str & "Error Description : " & ErrorDesc & vbCrLf
str = str & "----------------------------------------------------" & vbCrLf
Open App.Path & "\Error.Log" For Append As iFileNumberWrite
Print #iFileNumberWrite, str
Close #iFileNumberWrite
End Sub
Dim iFileNumberWrite As Integer, str As String
iFileNumberWrite = FreeFile
str = ""
str = str & "On DateTime : " & Format(Now, "dd-MMM-yyyy HH:mm:ss") & vbCrLf
str = str & "Module Name : " & ModuleName & vbCrLf
str = str & "Function Name : " & FunctionName & vbCrLf
str = str & "Error Description : " & ErrorDesc & vbCrLf
str = str & "----------------------------------------------------" & vbCrLf
Open App.Path & "\Error.Log" For Append As iFileNumberWrite
Print #iFileNumberWrite, str
Close #iFileNumberWrite
End Sub
July 10, 2009
.Net- Difference between Class and Struct.
1- Classes are references type that required to allocate of heap.
1- Struct are values type that do not required to allocate of heap
2- Classes contains a referance of the data.
2- Struct directly contains the original data.
3- Classes can inherit from other classes and interface.
3- Struct can inherit from interface only.
4- Classes are used to store larger data(more data 16 bytes)
4- Struct are used to store less data(16 bytes or less)
5- To instantiate an object of a class, you use the new keyword.
5- You donot require the new keyword to create a instane of a struct.
1- Struct are values type that do not required to allocate of heap
2- Classes contains a referance of the data.
2- Struct directly contains the original data.
3- Classes can inherit from other classes and interface.
3- Struct can inherit from interface only.
4- Classes are used to store larger data(more data 16 bytes)
4- Struct are used to store less data(16 bytes or less)
5- To instantiate an object of a class, you use the new keyword.
5- You donot require the new keyword to create a instane of a struct.
July 3, 2009
VB.Net- Enter AlphaNumeric Values
Private Sub txtRemark_KeyPress(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyPressEventArgs) Handles
txtRemark.KeyPresse.Handled = OnlyAlphaNumeric(e.KeyChar)
End Sub
Public Function OnlyAlphaNumeric(ByVal Value As String) As Boolean
OnlyAlphaNumeric = True
If (Microsoft.VisualBasic.Asc(Value) >= 65 And Microsoft.VisualBasic.Asc(Value) <= 90) _ Or (Microsoft.VisualBasic.Asc(Value) >= 97 And Microsoft.VisualBasic.Asc(Value) <= 122) _ Or (Microsoft.VisualBasic.Asc(Value) >= 48 And Microsoft.VisualBasic.Asc(Value) <= 57) Then
OnlyAlphaNumeric = False
End If
If (Microsoft.VisualBasic.Asc(Value) = 32) Then OnlyAlphaNumeric = False End If
If (Microsoft.VisualBasic.Asc(Value) = 13) Then OnlyAlphaNumeric = False End If
End Function
June 13, 2009
Sql Server - Generate Auto number in Select Query
SELECT ROW_NUMBER() OVER (ORDER BY ColumnName ASC) AS ROWID, * FROM Tablename
SQL Server - constraint
A constraint is assigned to a column or the set of columns in a table that prevents certain types of inconsistent data values from being placed in the column(s).
Constraints are used to enforce the data integrity.
This ensures the accuracy and reliability of the data in the database. The following categories of the data integrity exist:
• Entity Integrity
ensures that there are no duplicate rows in a table.
• Domain Integrity
enforces valid entries for a given column by restricting the type, the
format, or the range of possible values.
• A product name cannot be NULL.
• A product name must be unique.
• The date of an order must not be in the future.
• The product quantity in an order must be greater than zero.
• Referential integrity
ensures the relationships between tables remain preserved as data is inserted, deleted, and modified.
enforces some specific business rules that do not fall into entity, domain, or referential integrity categories.
Microsoft SQL Server supports the following constraints:
• PRIMARY KEY
• UNIQUE
• FOREIGN KEY
• CHECK
• NOT NULL
Constraints are used to enforce the data integrity.
This ensures the accuracy and reliability of the data in the database. The following categories of the data integrity exist:
• Entity Integrity
ensures that there are no duplicate rows in a table.
It specifying a PRIMARY KEY constraint.Example: the ProductID column of the Products table is a primary key for the table.
• Domain Integrity
enforces valid entries for a given column by restricting the type, the
format, or the range of possible values.
It specifying a CHECK constraints, UNIQUE constraints, and DEFAULT constraints.The following list gives a sampling of domain integrity constraints.
• A product name cannot be NULL.
• A product name must be unique.
• The date of an order must not be in the future.
• The product quantity in an order must be greater than zero.
• Referential integrity
ensures the relationships between tables remain preserved as data is inserted, deleted, and modified.
It specifying a FOREIGN KEY constraint.• User-Defined Integrity
enforces some specific business rules that do not fall into entity, domain, or referential integrity categories.
Microsoft SQL Server supports the following constraints:
• PRIMARY KEY
• UNIQUE
• FOREIGN KEY
• CHECK
• NOT NULL
June 5, 2009
Vb.Net - Get system IP Address and Name
Dim LocalHostName As String
LocalHostName = GetHostName()
Dim ipEnter As IPHostEntry = GetHostByName(LocalHostName)
Dim IpAdd() As IPAddress = ipEnter.AddressList
strSystemIP = IpAdd(0).ToString()
LocalHostName = GetHostName()
Dim ipEnter As IPHostEntry = GetHostByName(LocalHostName)
Dim IpAdd() As IPAddress = ipEnter.AddressList
strSystemIP = IpAdd(0).ToString()
May 25, 2009
Vb.Net - Write Excel File for all version Part 2
Module modExcel
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
''' True means file saved sucessfully and False means file is not saved.
'''
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
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
Vb.Net - Write Excel File for all version Part 1
Note :: Declare in Separate module
'********************* Start Module Excel Variable declartion ********************
Public xlsApplication As Object
Public xlsWorkbook As Object
Public xlsSheet As Object
Public HeaderColumnNumber As Integer, HeaderRowNumber As Integer
Enum amdVerticalAlignment
amdCenter = -4108
amdBottom = -4107
amdTop = -4160
amdVjustify = -4130
End Enum
Enum amdHorizontalAlignment
amdJustify = -4130
amdLeft = -4131
amdCenter = -4108
amdRight = -4152
End Enum
Enum amdCellBroder
RightEdge = 2
LeftEdge = 1
TopEdge = 3
BottonEdge = 4
AllEdge = 5
End Enum
Enum amdBorderline
amdThink = 1
amdThick1 = 2
amdThick2 = 3
amdThick3 = 4
End Enum
Enum amdColors
Black = 1
White = 2
Red = 3
BrightGreen = 4
Blue = 5
Yellow = 6
Pink = 7
Turquoise = 8
DarkRed = 9
Green = 10
DarkBlue = 11
DarkYellow = 12
Violet = 13
Teal = 14
Grey25Per = 15
Grey50Per = 16
SkyBlue = 33
LightTurtoise = 34
LightGreen = 35
LightYellow = 36
PaleBlue = 37
Rose = 38
Lavender = 39
Tan = 40
LightBlue = 41
Aqua = 42
Lime = 43
Gold = 44
LightOrange = 45
Orange = 46
BlueGray = 47
Gray40Per = 48
DarkTeal = 49
SeaGreen = 50
DarkGreen = 51
OliveGreen = 52
Brown = 53
Plum = 54
Indigo = 55
Gray80Per = 56
End Enum
Enum ImgPosition
PageHeader = 0
PageFooter = 1
End Enum
Enum ImgPositionAlign
AlignLeft = 0
Alignright = 1
AlignCenter = 2
End Enum
'********************* end Module Excel Variable declartion ********************
Continue in Vb.Net - Write Excel File for all version Part 2 .....
'********************* Start Module Excel Variable declartion ********************
Public xlsApplication As Object
Public xlsWorkbook As Object
Public xlsSheet As Object
Public HeaderColumnNumber As Integer, HeaderRowNumber As Integer
Enum amdVerticalAlignment
amdCenter = -4108
amdBottom = -4107
amdTop = -4160
amdVjustify = -4130
End Enum
Enum amdHorizontalAlignment
amdJustify = -4130
amdLeft = -4131
amdCenter = -4108
amdRight = -4152
End Enum
Enum amdCellBroder
RightEdge = 2
LeftEdge = 1
TopEdge = 3
BottonEdge = 4
AllEdge = 5
End Enum
Enum amdBorderline
amdThink = 1
amdThick1 = 2
amdThick2 = 3
amdThick3 = 4
End Enum
Enum amdColors
Black = 1
White = 2
Red = 3
BrightGreen = 4
Blue = 5
Yellow = 6
Pink = 7
Turquoise = 8
DarkRed = 9
Green = 10
DarkBlue = 11
DarkYellow = 12
Violet = 13
Teal = 14
Grey25Per = 15
Grey50Per = 16
SkyBlue = 33
LightTurtoise = 34
LightGreen = 35
LightYellow = 36
PaleBlue = 37
Rose = 38
Lavender = 39
Tan = 40
LightBlue = 41
Aqua = 42
Lime = 43
Gold = 44
LightOrange = 45
Orange = 46
BlueGray = 47
Gray40Per = 48
DarkTeal = 49
SeaGreen = 50
DarkGreen = 51
OliveGreen = 52
Brown = 53
Plum = 54
Indigo = 55
Gray80Per = 56
End Enum
Enum ImgPosition
PageHeader = 0
PageFooter = 1
End Enum
Enum ImgPositionAlign
AlignLeft = 0
Alignright = 1
AlignCenter = 2
End Enum
'********************* end Module Excel Variable declartion ********************
Continue in Vb.Net - Write Excel File for all version Part 2 .....
Vb.net - Read Excel File
'********************* Start Module ReadExcel Variable (This declare in module file.)
Public arrExcelColumnName() As String
Public arrExcelSheetName() As String
Public rsExcelData As ADODB.Recordset
Public arrValues(,) As String
'********************* End Module ReadExcel Variable
Module modReadExcel
Public adoConn As ADODB.Connection
Public rs As ADODB.Recordset
Dim mrstrConString As String
Dim strFilePath As String
Public Sub SetFilePath(ByVal Value As String)
Try
Dim objFso
objFso = CreateObject("Scripting.FileSystemObject")
If objFso.FileExists(Value) = True Then
strFilePath = Value
End If
Catch ex As Exception
MessageBox.Show("Error Is Found In : " & vbCrLf & " Module Name : SetFilePath " & vbCrLf & _
"Error Description : " & ex.Message)
End Try
End Sub
Public Sub SetConnectionString(ByVal Value As String)
SetFilePath(Value)
If strFilePath <> "" Then
If InStr(1, strFilePath, ".xlsx") > 0 Then
mrstrConString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFilePath & ";Extended Properties=""Excel 12.0;HDR=YES"""
ElseIf InStr(1, strFilePath, ".xls") > 0 Then
mrstrConString = "DRIVER=Microsoft Excel Driver (*.xls);" & "DBQ=" & strFilePath
End If
Else
mrstrConString = ""
End If
End Sub
Public Function SetConnection(ByVal sEnum As ADODB.SchemaEnum, Optional ByVal SheetName As String = Nothing) As Boolean
Try
SetConnection = False
If mrstrConString = "" Then
SetConnectionString()
If mrstrConString = "" Then
SetConnection = False
Exit Function
End If
End If
adoConn = Nothing
adoConn = New ADODB.Connection
adoConn.CursorLocation = 1
adoConn.Open(mrstrConString)
Dim arr(0 To 3) As Object
Dim Catalog As Object
Dim Schema As Object
Dim TableName As Object
Dim TableType As Object
Catalog = Nothing
Schema = Nothing
TableName = SheetName
TableType = Nothing
arr(0) = Catalog
arr(1) = Schema
arr(2) = TableName
arr(3) = TableType
rs = adoConn.OpenSchema(sEnum, arr)
SetConnection = True
Catch ex As Exception
SetConnection = False
MessageBox.Show("Error Is Found In : " & vbCrLf & " Module Name : SetConnection" & vbCrLf & _
"Error Description : " & ex.Message)
End Try
End Function
Public Sub GetSheetName()
Dim arrlocal() As String
Try
SetConnection(ADODB.SchemaEnum.adSchemaTables)
ReDim Preserve arrlocal(0)
Dim i As Integer = 0
If Not (rs.BOF And rs.EOF) Then
rs.MoveFirst()
While (rs.EOF = False)
arrlocal(i) = rs.Fields("TABLE_NAME").Value & ""
ReDim Preserve arrlocal(UBound(arrlocal) + 1)
i += 1
rs.MoveNext()
End While
ReDim Preserve arrExcelSheetName(UBound(arrlocal) - 1)
For i = LBound(arrlocal) To UBound(arrlocal) - 1
arrExcelSheetName(i) = arrlocal(i)
Next
End If
Catch ex As Exception
Finally
arrlocal = Nothing
End Try
End Sub
Public Sub GetExcelColumnName(ByVal SheetName As String)
SetConnection(ADODB.SchemaEnum.adSchemaColumns, SheetName)
arrExcelColumnName = Nothing
ReDim Preserve arrExcelColumnName(0)
Dim i As String = 0
If Not (rs.BOF And rs.EOF) Then
rs.MoveFirst()
While (rs.EOF = False)
arrExcelColumnName(i) = rs.Fields("COLUMN_NAME").Value & ""
ReDim Preserve arrExcelColumnName(UBound(arrExcelColumnName) + 1)
i += 1
rs.MoveNext()
End While
End If
End Sub
Public Sub GetExcelData(ByVal SheetName As String, Optional ByVal SpColumnName As String = "[AllData]")
Try
SetConnection(ADODB.SchemaEnum.adSchemaColumns, SheetName)
Dim i As Integer, j As Integer
rsExcelData = Nothing
rsExcelData = New ADODB.Recordset
If InStr(1, SpColumnName, ",") > 0 Then
SpColumnName = "[" & Replace(SpColumnName, ",", "],[") & "]"
End If
If SpColumnName.ToUpper() = "[AllData]".ToUpper() Then
rsExcelData.Open("SELECT * FROM [" & SheetName & "]", mrstrConString, ADODB.CursorTypeEnum.adOpenStatic, ADODB.LockTypeEnum.adLockReadOnly)
ElseIf SpColumnName.ToUpper().Trim() <> "" Then
rsExcelData.Open("SELECT " & SpColumnName & " FROM [" & SheetName & "]", mrstrConString, ADODB.CursorTypeEnum.adOpenStatic, ADODB.LockTypeEnum.adLockReadOnly)
End If
arrValues = Nothing
ReDim arrValues(Convert.ToInt64(rsExcelData.Fields.Count), 0)
For i = 0 To rsExcelData.RecordCount - 1
For j = 0 To rsExcelData.Fields.Count - 1
arrValues(j, i) = Trim$(rsExcelData.Fields(j).Value & " ")
Next
rsExcelData.MoveNext()
ReDim Preserve arrValues(Convert.ToInt64(rsExcelData.Fields.Count), UBound(arrValues, 2) + 1)
Next
Catch ex As Exception
If InStr(1, ex.Message, "Too few parameters") > 0 Then
MessageBox.Show("Invalid Column Name." & vbCrLf & ex.Message)
ElseIf InStr(1, ex.Message, "in date in query expression") > 0 Then
MessageBox.Show("Invaild query expression." & vbCrLf & Err.Description)
Else
MessageBox.Show("Error Found. " & vbCrLf & Err.Description)
End If
arrValues = Nothing
End Try
End Sub
End Module
Public arrExcelColumnName() As String
Public arrExcelSheetName() As String
Public rsExcelData As ADODB.Recordset
Public arrValues(,) As String
'********************* End Module ReadExcel Variable
Module modReadExcel
Public adoConn As ADODB.Connection
Public rs As ADODB.Recordset
Dim mrstrConString As String
Dim strFilePath As String
Public Sub SetFilePath(ByVal Value As String)
Try
Dim objFso
objFso = CreateObject("Scripting.FileSystemObject")
If objFso.FileExists(Value) = True Then
strFilePath = Value
End If
Catch ex As Exception
MessageBox.Show("Error Is Found In : " & vbCrLf & " Module Name : SetFilePath " & vbCrLf & _
"Error Description : " & ex.Message)
End Try
End Sub
Public Sub SetConnectionString(ByVal Value As String)
SetFilePath(Value)
If strFilePath <> "" Then
If InStr(1, strFilePath, ".xlsx") > 0 Then
mrstrConString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFilePath & ";Extended Properties=""Excel 12.0;HDR=YES"""
ElseIf InStr(1, strFilePath, ".xls") > 0 Then
mrstrConString = "DRIVER=Microsoft Excel Driver (*.xls);" & "DBQ=" & strFilePath
End If
Else
mrstrConString = ""
End If
End Sub
Public Function SetConnection(ByVal sEnum As ADODB.SchemaEnum, Optional ByVal SheetName As String = Nothing) As Boolean
Try
SetConnection = False
If mrstrConString = "" Then
SetConnectionString()
If mrstrConString = "" Then
SetConnection = False
Exit Function
End If
End If
adoConn = Nothing
adoConn = New ADODB.Connection
adoConn.CursorLocation = 1
adoConn.Open(mrstrConString)
Dim arr(0 To 3) As Object
Dim Catalog As Object
Dim Schema As Object
Dim TableName As Object
Dim TableType As Object
Catalog = Nothing
Schema = Nothing
TableName = SheetName
TableType = Nothing
arr(0) = Catalog
arr(1) = Schema
arr(2) = TableName
arr(3) = TableType
rs = adoConn.OpenSchema(sEnum, arr)
SetConnection = True
Catch ex As Exception
SetConnection = False
MessageBox.Show("Error Is Found In : " & vbCrLf & " Module Name : SetConnection" & vbCrLf & _
"Error Description : " & ex.Message)
End Try
End Function
Public Sub GetSheetName()
Dim arrlocal() As String
Try
SetConnection(ADODB.SchemaEnum.adSchemaTables)
ReDim Preserve arrlocal(0)
Dim i As Integer = 0
If Not (rs.BOF And rs.EOF) Then
rs.MoveFirst()
While (rs.EOF = False)
arrlocal(i) = rs.Fields("TABLE_NAME").Value & ""
ReDim Preserve arrlocal(UBound(arrlocal) + 1)
i += 1
rs.MoveNext()
End While
ReDim Preserve arrExcelSheetName(UBound(arrlocal) - 1)
For i = LBound(arrlocal) To UBound(arrlocal) - 1
arrExcelSheetName(i) = arrlocal(i)
Next
End If
Catch ex As Exception
Finally
arrlocal = Nothing
End Try
End Sub
Public Sub GetExcelColumnName(ByVal SheetName As String)
SetConnection(ADODB.SchemaEnum.adSchemaColumns, SheetName)
arrExcelColumnName = Nothing
ReDim Preserve arrExcelColumnName(0)
Dim i As String = 0
If Not (rs.BOF And rs.EOF) Then
rs.MoveFirst()
While (rs.EOF = False)
arrExcelColumnName(i) = rs.Fields("COLUMN_NAME").Value & ""
ReDim Preserve arrExcelColumnName(UBound(arrExcelColumnName) + 1)
i += 1
rs.MoveNext()
End While
End If
End Sub
Public Sub GetExcelData(ByVal SheetName As String, Optional ByVal SpColumnName As String = "[AllData]")
Try
SetConnection(ADODB.SchemaEnum.adSchemaColumns, SheetName)
Dim i As Integer, j As Integer
rsExcelData = Nothing
rsExcelData = New ADODB.Recordset
If InStr(1, SpColumnName, ",") > 0 Then
SpColumnName = "[" & Replace(SpColumnName, ",", "],[") & "]"
End If
If SpColumnName.ToUpper() = "[AllData]".ToUpper() Then
rsExcelData.Open("SELECT * FROM [" & SheetName & "]", mrstrConString, ADODB.CursorTypeEnum.adOpenStatic, ADODB.LockTypeEnum.adLockReadOnly)
ElseIf SpColumnName.ToUpper().Trim() <> "" Then
rsExcelData.Open("SELECT " & SpColumnName & " FROM [" & SheetName & "]", mrstrConString, ADODB.CursorTypeEnum.adOpenStatic, ADODB.LockTypeEnum.adLockReadOnly)
End If
arrValues = Nothing
ReDim arrValues(Convert.ToInt64(rsExcelData.Fields.Count), 0)
For i = 0 To rsExcelData.RecordCount - 1
For j = 0 To rsExcelData.Fields.Count - 1
arrValues(j, i) = Trim$(rsExcelData.Fields(j).Value & " ")
Next
rsExcelData.MoveNext()
ReDim Preserve arrValues(Convert.ToInt64(rsExcelData.Fields.Count), UBound(arrValues, 2) + 1)
Next
Catch ex As Exception
If InStr(1, ex.Message, "Too few parameters") > 0 Then
MessageBox.Show("Invalid Column Name." & vbCrLf & ex.Message)
ElseIf InStr(1, ex.Message, "in date in query expression") > 0 Then
MessageBox.Show("Invaild query expression." & vbCrLf & Err.Description)
Else
MessageBox.Show("Error Found. " & vbCrLf & Err.Description)
End If
arrValues = Nothing
End Try
End Sub
End Module
March 4, 2009
Vb.net - Enter only Character Values
Private Sub txtCity_KeyPress(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyPressEventArgs)
Handles txtCity.KeyPress
e.Handled = OnlyCharacter(e.KeyChar)
End Sub
Public Function OnlyCharacter(ByVal Value As String) As Boolean
If (Microsoft.VisualBasic.Asc(Value) <> 90) _
And (Microsoft.VisualBasic.Asc(Value) <> 122) Then
'space accepted
If (Microsoft.VisualBasic.Asc(Value) <> 32) Then
OnlyCharacter = True
End If
End If
If (Microsoft.VisualBasic.Asc(Value) = 8) Then
OnlyCharacter = False
End If
End Function
Handles txtCity.KeyPress
e.Handled = OnlyCharacter(e.KeyChar)
End Sub
Public Function OnlyCharacter(ByVal Value As String) As Boolean
If (Microsoft.VisualBasic.Asc(Value) <> 90) _
And (Microsoft.VisualBasic.Asc(Value) <> 122) Then
'space accepted
If (Microsoft.VisualBasic.Asc(Value) <> 32) Then
OnlyCharacter = True
End If
End If
If (Microsoft.VisualBasic.Asc(Value) = 8) Then
OnlyCharacter = False
End If
End Function
Vb.net - Enter only Numeric Values
Private Sub txtbox1_KeyPress(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyPressEventArgs) Handles txtbox1.KeyPress
e.Handled = OnlyNumeric(e.KeyChar)
End Sub
Public Function OnlyNumeric(ByVal Value As String) As Boolean
OnlyNumeric = True
If (Microsoft.VisualBasic.Asc(Value) > 47) And (Microsoft.VisualBasic.Asc(Value) < 59) Then
OnlyNumeric = False
End If
If (Microsoft.VisualBasic.Asc(Value) = 8) Then
OnlyNumeric = False
End If
End Function
e.Handled = OnlyNumeric(e.KeyChar)
End Sub
Public Function OnlyNumeric(ByVal Value As String) As Boolean
OnlyNumeric = True
If (Microsoft.VisualBasic.Asc(Value) > 47) And (Microsoft.VisualBasic.Asc(Value) < 59) Then
OnlyNumeric = False
End If
If (Microsoft.VisualBasic.Asc(Value) = 8) Then
OnlyNumeric = False
End If
End Function
Vb.net - Save File Dialog box
dim strSaveFile as string
With SaveFileDialog1
.CheckFileExists = False
.Filter = "Word Documents(*.doc)*.doc"
.FilterIndex = 1
If .ShowDialog() = Windows.Forms.DialogResult.OK Then
strSaveFile = .FileName()
End If
End with
With SaveFileDialog1
.CheckFileExists = False
.Filter = "Word Documents(*.doc)*.doc"
.FilterIndex = 1
If .ShowDialog() = Windows.Forms.DialogResult.OK Then
strSaveFile = .FileName()
End If
End with
Vb.net - Generate word file from world file template
Private Sub GenrateWord()
Try
Dim openFileDialog As New OpenFileDialog
Dim a() As Object = {}
openFileDialog.FileName = System.AppDomain.CurrentDomain.BaseDirectory() & "Final.doc"
Dim filename As Object = openFileDialog.FileName
Dim wordType As Type = Type.GetTypeFromProgID("Word.Application")
Dim wordApplication As Object = Activator.CreateInstance(wordType)
wordType.InvokeMember("Visible", Reflection.BindingFlags.SetProperty, Nothing, wordApplication, New Object() {False})
Dim wordDocuments As Object = wordType.InvokeMember("Documents", Reflection.BindingFlags.GetProperty, Nothing, wordApplication, a)
Dim wordDocument As Object = wordType.InvokeMember("Open", Reflection.BindingFlags.InvokeMethod, Nothing, wordDocuments, New Object() {filename})
Dim activeWindow As Object = wordDocument.[GetType]().InvokeMember("ActiveWindow", Reflection.BindingFlags.GetProperty, Nothing, wordDocument, Nothing)
Dim selection As Object = activeWindow.[GetType]().InvokeMember("Selection", Reflection.BindingFlags.GetProperty, Nothing, activeWindow, Nothing)
selection.[GetType]().InvokeMember("WholeStory", Reflection.BindingFlags.InvokeMethod, Nothing, selection, Nothing)
selection.[GetType]().InvokeMember("Copy", Reflection.BindingFlags.InvokeMethod, Nothing, selection, Nothing)
wordDocument.[GetType]().InvokeMember("Close", Reflection.BindingFlags.InvokeMethod, Nothing, wordDocument, Nothing)
wordApplication.[GetType]().InvokeMember("Quit", Reflection.BindingFlags.InvokeMethod, Nothing, wordApplication, Nothing)
Dim data As IDataObject = Clipboard.GetDataObject()
Dim text As String = data.GetData(DataFormats.Rtf, True).ToString()
Dim fs As New FileStream(strSaveFile, FileMode.Create, FileAccess.Write)
'declaring a FileStream and creating a document file named file with access mode of writing
Dim s As New StreamWriter(fs)
'creating a new StreamWriter and passing the filestream object fs as argument
text = text.Replace("{TODate}", System.DateTime.Now.Year().ToString())
s.Write(text)
'writing text to the newly created file
s.Close()
MessageBox.Show("Process has been done Successfully.", Msgboxtitle, MessageBoxButtons.OK, MessageBoxIcon.Information)
Catch ex As Exception
MessageBox.Show(ex.Message, Msgboxtitle, MessageBoxButtons.OK, MessageBoxIcon.Error)
End Try
End Sub
Subscribe to:
Posts (Atom)