Navigate Tools -> Macro -> Visual Basic Editor to start coding.
Enable Macro in your computer by navigating Tools -> Macro -> Security. Keep the security level Medium/Low.
Lets start programming...
1. Add the values available in two cells and diplay the result in the next cell as given below...
| . | A |
| 1 | Value-1 |
| 2 | Value-2 |
| 3 | Result |
Have a command button and name it "cmdAdd". We can achieve the result by clicking on the button.
Result can be displayed using any of the following code...
a. Use Excel Formula "=SUM" ...
Private Sub cmdAdd_Click()
ThisWorkbook.Worksheets("Sheet1").Cells(3, 1) = "=SUM(A1:A2)"
End Sub
b. Use the normal Visual Basic code ...
Private Sub cmdAdd_Click()
ThisWorkbook.Worksheets("Sheet1").Cells(3, 1) = _
Val(ThisWorkbook.Worksheets("Sheet1").Cells(1, 1)) + _
Val(ThisWorkbook.Worksheets("Sheet1").Cells(2, 1))
End Sub
2. We have values from cell-1 to cell-10. Our requirement is to display the SUM of odd numbers to cell-11.
| . | A |
| 1 | 12 |
| 2 | 23 |
| 3 | 45 |
| 4 | 3 |
| 5 | 76 |
| 6 | 27 |
| 7 | 8 |
| 8 | 34 |
| 9 | 91 |
| 10 | 68 |
| 11 | 189 |
How do we acheive this? Use the following code...
Private Sub cmdAdd_Click()
Dim iDx As Integer, theSum As Integer
theSum = 0
For iDx = 1 To 10
If Val(ThisWorkbook.Worksheets("Sheet1").Cells(iDx, 1)) Mod 2 = 1 Then
theSum = theSum + Val(ThisWorkbook.Worksheets("Sheet1").Cells(iDx, 1))
End If
Next iDx
ThisWorkbook.Worksheets("Sheet1").Cells(iDx, 1) = theSum
End Sub
3. Border formatting on a single cell or range of cells...
| . | A | B | C |
| 1 | . | . | . |
| 2 | . | Formatted cell | . |
| 3 | . | . | . |
Any way to achieve this by code? Yes! refer the following code...
a. Borders style for a single cell ...
Private Sub cmdFormat_Click()
Dim fmtSht As Excel.Worksheet
Set fmtSht = ThisWorkbook.Worksheets("Sheet1")
fmtSht.Cells(2, 2) = "Formatted cell"
fmtSht.Cells(2, 2).Borders.LineStyle = xlContinuous
fmtSht.Cells(2, 2).Borders.Weight = xlMedium
fmtSht.Cells(2, 2).Borders.ColorIndex = 3
End Sub
b. Borders style for range of cells ...
Private Sub cmdFormat_Click()
Dim fmtSht As Excel.Worksheet
Set fmtSht = ThisWorkbook.Worksheets("Sheet1")
fmtSht.Range("B2:D4").Borders.LineStyle = xlContinuous
fmtSht.Range("B2:D4").Borders.Weight = xlMedium
fmtSht.Range("B2:D4").Borders.ColorIndex = 3
End Sub
c. Borders style for a complete row ...
Private Sub cmdFormat_Click()
Dim fmtSht As Excel.Worksheet
Set fmtSht = ThisWorkbook.Worksheets("Sheet1")
fmtSht.Rows(3).Borders.LineStyle = xlContinuous
fmtSht.Rows(3).Borders.Weight = xlMedium
fmtSht.Rows(3).Borders.ColorIndex = 3
End Sub
d. Borders style for a complete column...
Private Sub cmdFormat_Click()
Dim fmtSht As Excel.Worksheet
Set fmtSht = ThisWorkbook.Worksheets("Sheet1")
fmtSht.Columns("B").Borders.LineStyle = xlContinuous
fmtSht.Columns(2).Borders.Weight = xlMedium
fmtSht.Columns("B").Borders.ColorIndex = 3
End Sub
Other LineStyles ...
* xlAutomatic
* xlContinuous
* xlDashDot
* xlDashDotDot
* xlNone
Other Weights ...
* xlHairline
* xlThin
* xlMedium
* xlThick
Other ColorIndexes ...
e. We can even have custom formatting as below. It will work for both signle as well as range of cells...
Private Sub xlBorders(xlRange As Range, OutLineWeight As String, InLineWeight As String, Optional OutLineColor As Long = -4105, Optional InLineColor As Long = -4105)
'*******************************************************************************
' Function generates Inside and Outside borders for a target range
' Passed Values
' xlRange [in, range] target range
' OutLineWeight [in, string] weight of Outerior lines:
' hairline, thin, medium, thick, none
' InLineWeight [in, string] weight of Interior lines:
' hairline, thin, medium, thick, none
' OutLineColor [in, long, OPTIONAL] outside line color {default = xlAutomatic}
' InLineColor [in, long, OPTIONAL] inside line color {default = xlAutomatic}
'
'*******************************************************************************
Dim OutLineStyle As Variant
Dim OutLineWt As Variant
Dim InLineStyle As Variant
Dim InLineWt As Variant
OutLineStyle = xlContinuous
Select Case LCase(OutLineWeight)
Case "hairline"
OutLineWt = xlHairline
Case "thin"
OutLineWt = xlThin
Case "medium"
OutLineWt = xlMedium
Case "thick"
OutLineWt = xlThick
Case "none"
OutLineStyle = xlNone
Case "auto"
InLineStyle = xlAutomatic
End Select
InLineStyle = xlContinuous
Select Case LCase(InLineWeight)
Case "hairline"
InLineWt = xlHairline
Case "thin"
InLineWt = xlThin
Case "medium"
InLineWt = xlMedium
Case "thick"
InLineWt = xlThick
Case "none"
InLineStyle = xlNone
Case "auto"
InLineStyle = xlAutomatic
End Select
xlRange.Borders(xlDiagonalDown).LineStyle = xlNone
xlRange.Borders(xlDiagonalUp).LineStyle = xlNone
With xlRange.Borders(xlEdgeLeft)
.LineStyle = OutLineStyle
.Weight = OutLineWt
.ColorIndex = OutLineColor
End With
With xlRange.Borders(xlEdgeTop)
.LineStyle = OutLineStyle
.Weight = OutLineWt
.ColorIndex = OutLineColor
End With
With xlRange.Borders(xlEdgeBottom)
.LineStyle = OutLineStyle
.Weight = OutLineWt
.ColorIndex = OutLineColor
End With
With xlRange.Borders(xlEdgeRight)
.LineStyle = OutLineStyle
.Weight = OutLineWt
.ColorIndex = OutLineColor
End With
With xlRange.Borders(xlInsideVertical)
.LineStyle = InLineStyle
.Weight = InLineWt
.ColorIndex = InLineColor
End With
With xlRange.Borders(xlInsideHorizontal)
.LineStyle = InLineStyle
.Weight = InLineWt
.ColorIndex = InLineColor
End With
End Sub
Call the above procedure as below...
Private Sub cmdFormat_Click()
Dim fmtSht As Excel.Worksheet
Set fmtSht = ThisWorkbook.Worksheets("Sheet1")
Call xlBorders(fmtSht.Range("B2:D4"), "medium", "thin", 3, 1)
End Sub
The above format will be applied to the range B2-D4. The outer border will be medium thickness and inner (individual cells) border will be thin. Outer border color will be Red (3) and inner cells color will be Black (1).
f. Change background color ...
Private Sub cmdFormat_Click()
Worksheets("Sheet1").Cells(3, 4).Interior.ColorIndex = 3
Worksheets("Sheet1").Columns("B").Interior.ColorIndex = 3
Worksheets("Sheet1").Rows(6).Interior.ColorIndex = 3
Worksheets("Sheet1").Range("C4:F6").Interior.ColorIndex = 3
End Sub
g. Font styles ...
Private Sub cmdFormat_Click()
Dim Rng As Range
Set Rng = Worksheets("Sheet1").Range("B2:D3")
Rng.Font.Bold = True
Rng.Font.Color = RGB(15, 0, 0)
Rng.Font.ColorIndex = 3
Rng.Font.Italic = True
Rng.Font.Name = "Courier"
Rng.Font.OutlineFont = True
Rng.Font.Size = 30
Rng.Font.Strikethrough = True
Rng.Font.Subscript = True
Rng.Font.Superscript = True
Rng.Font.Underline = True
End Sub
h. Setting Font and formatting within a cell ...
In the three rows and columns of data (Selection)... search for "Ram", make it bold and search for "Yes", change the color to red.
| . | A | B | C |
| 1 | Hello Ram | Hi Ram How | Ram Yes |
| 2 | Hello sir | Excuse me | Yes Ram |
| 3 | Good morning | Wel Ram come | Write Ram |
How can we do this? Use the following code...
Private Sub cmdFormat_Click()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim Cel As Range
Dim Rng As Range
Set Rng = Intersect(Selection, ActiveSheet.UsedRange)
If Not Rng Is Nothing Then
For Each Cel In Rng
Cel = Cel.Value 'Convert to constant
If InStr(1, Cel.Value, "Ram", 1) > 0 Then ' 1 for Text (case insensitive)
With Cel.Characters(InStr(1, Cel.Value, "Ram", 1), Len("Ram")).Font
.FontStyle = "Bold"
End With
End If
If InStr(1, Cel.Value, "Yes", 1) > 0 Then
Cel.Characters(InStr(1, Cel.Value, "Yes", 1), Len("Yes")).Font.ColorIndex = 3
End If
Next Cel
End If
End Sub
4. Inserting picture in a range of cells ...
Writing a sub procedure...
Private Sub InsertPicture(PictureFileName As String, TargetCell As Range, CenterH As Boolean, CenterV As Boolean)
Dim p As Object, T As Double, L As Double, W As Double, H As Double
If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
If Dir(PictureFileName) = "" Then Exit Sub
Set p = ActiveSheet.Pictures.Insert(PictureFileName)
With TargetCell
T = .Top
L = .Left
If CenterH Then
W = .Offset(0, 1).Left - .Left
L = L + W / 2 - p.Width / 2
If L < 1 Then L = 1
End If
If CenterV Then
H = .Offset(1, 0).Top - .Top
T = T + H / 2 - p.Height / 2
If T < 1 Then T = 1
End If
End With
With p
.Top = T
.Left = L
End With
Set p = Nothing
End Sub
Call the procedure...
Private Sub cmdFormat_Click()
InsertPicture "C:\Documents and Settings\Admin\Desktop\picture.jpg", Range("H10"), True, True
End Sub
5. Browse for a file ...
Private Sub cmdBrowse_Click()
Dim fName
Dim fndFile
fName = Application.GetOpenFilename
If fName = False Then
Worksheets("Sheet1").Cells(3, 3) = ""
Else
Worksheets("Sheet1").Cells(3, 3) = fName
End If
End Sub
6. Browse for a folder ...
Private Const BIF_RETURNONLYFSDIRS As Long = &H1
Private Const BIF_DONTGOBELOWDOMAIN As Long = &H2
Private Const BIF_RETURNFSANCESTORS As Long = &H8
Private Const BIF_BROWSEFORCOMPUTER As Long = &H1000
Private Const BIF_BROWSEFORPRINTER As Long = &H2000
Private Const BIF_BROWSEINCLUDEFILES As Long = &H4000
Private Const MAX_PATH As Long = 260
Private Type BrowseInfo
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszINSTRUCTIONS As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Private Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Boolean
hNameMappings As Long
lpszProgressTitle As String
End Type
Private Declare Function SHGetPathFromIDListA Lib "shell32.dll" (ByVal pidl As Long, ByVal pszBuffer As String) As Long
Private Declare Function SHBrowseForFolderA Lib "shell32.dll" (lpBrowseInfo As BrowseInfo) As Long
Function BrowseFolder(Optional Caption As String = "") As String
Dim BrowseInfo As BrowseInfo
Dim FolderName As String
Dim ID As Long
Dim Res As Long
With BrowseInfo
.hOwner = 0
.pidlRoot = 0
.pszDisplayName = String$(MAX_PATH, vbNullChar)
.lpszINSTRUCTIONS = Caption
.ulFlags = BIF_RETURNONLYFSDIRS
.lpfn = 0
End With
FolderName = String$(MAX_PATH, vbNullChar)
ID = SHBrowseForFolderA(BrowseInfo)
If ID Then
Res = SHGetPathFromIDListA(ID, FolderName)
If Res Then
BrowseFolder = Left$(FolderName, InStr(FolderName, vbNullChar) - 1)
End If
End If
End Function
Private Sub cmdBrowseFolder_Click()
Dim fName
fName = BrowseFolder(Caption:="Select the folder")
If fName = vbNullString Then
Worksheets("Sheet1").Cells(7, 3) = ""
Else
Worksheets("Sheet1").Cells(7, 3) = fName
End If
End Sub
7. File operations ...
We can do text file manipulations in Excel VBA using Scripting.FileSystemObject
a. Create & Delete text files ...
Private Sub cmdFileOperations_Click()
Dim flOb As Object
Set flOb = CreateObject("Scripting.FileSystemObject")
If flOb.FolderExists("C:\Documents and Settings\Admin\Desktop\New Folder") Then
If Not flOb.FolderExists("C:\Documents and Settings\Admin\Desktop\New Folder\abcd.txt") Then
flOb.CreateTextFile ("C:\Documents and Settings\Admin\Desktop\New Folder\abcd.txt")
End If
flOb.DeleteFile "C:\Documents and Settings\Admin\Desktop\New Folder\abcd.txt"
'Kill "C:\Documents and Settings\Admin\Desktop\New Folder\abcd.txt"
End If
Set flOb=Nothing
End Sub
b. Write to text files ...
Private Sub cmdFileOperations_Click()
Dim flOb As Object
Dim objFile As Object
Set flOb = CreateObject("Scripting.FileSystemObject")
If Not flOb.FolderExists("C:\Documents and Settings\Admin\Desktop\New Folder") Then
flOb.CreateFolder ("C:\Documents and Settings\Admin\Desktop\New Folder")
End If
If Not flOb.FolderExists("C:\Documents and Settings\Admin\Desktop\New Folder\abcd.txt") Then
flOb.CreateTextFile ("C:\Documents and Settings\Admin\Desktop\New Folder\abcd.txt")
End If
Set objFile = flOb.OpenTextFile("C:\Documents and Settings\Admin\Desktop\New Folder\abcd.txt", 8, True)
'2 for Writing (Overwrite), 8 for Appending, 1 for Reading
objFile.WriteLine "Hello"
objFile.Write "Hi"
objFile.Write " How are you?"
objFile.WriteLine vbCrLf 'New line
objFile.WriteLine "Best Regards"
objFile.WriteLine "Ram"
objFile.Close
Set objFile = Nothing
Set flOb = Nothing
End Sub
c. Append to text files ...
Private Sub cmdFileOperations_Click()
Dim flOb As Object
Dim objFile As Object
Set flOb = CreateObject("Scripting.FileSystemObject")
Set objFile = flOb.OpenTextFile("C:\Documents and Settings\Admin\Desktop\New Folder\abcd.txt", 8, True)
objFile.WriteLine vbCrLf
objFile.WriteLine "Appending text line-1"
objFile.WriteLine "Appending text line-2"
objFile.WriteLine vbCrLf
objFile.WriteLine "By"
objFile.WriteLine "Ram"
objFile.Close
Set objFile = Nothing
Set flOb = Nothing
End Sub
d. Open the directory to view files ...
Private Sub cmdFileOperations_Click()
Set objShell = CreateObject("WScript.Shell")
objShell.Run ("Explorer" & " C:\Documents and Settings\Admin\Desktop\New Folder")
End Sub
e. Open the text file to view contents ...
Private Sub cmdFileOperations_Click()
Dim flOb As Object
Dim objFile As Object
Dim iDx As Long
Set flOb = CreateObject("Scripting.FileSystemObject")
Set objFile = flOb.OpenTextFile("C:\Documents and Settings\Admin\Desktop\New Folder\abcd.txt", 1, False)
iDx = 0
Do Until objFile.AtEndOfStream
'MsgBox objFile.ReadLine
iDx = iDx + 1
Worksheets("Sheet1").Cells(iDx, 1) = objFile.ReadLine
Loop
Set objFile = Nothing
Set flOb = Nothing
End Sub
f. Check file size before opening the file ...
Private Sub cmdFileOperations_Click()
Dim flOb As Object
Dim objFile As Object
Dim iDx As Long
Set flOb = CreateObject("Scripting.FileSystemObject")
Set objFile = flOb.GetFile("C:\Documents and Settings\Admin\Desktop\New Folder\abcd.txt")
If objFile.Size > 0 Then
Set objFile = flOb.OpenTextFile("C:\Documents and Settings\Admin\Desktop\New Folder\abcd.txt", 1, False)
iDx = 0
Do Until objFile.AtEndOfStream
iDx = iDx + 1
Worksheets("Sheet1").Cells(iDx, 1) = objFile.ReadLine
Loop
End If
Set objFile = Nothing
Set flOb = Nothing
End Sub
g. Get a temporary file name ...
Private Sub cmdFileOperations_Click()
Dim flOb As Object
Dim fileName As String
Set flOb = CreateObject("Scripting.FileSystemObject")
fileName = flOb.GetTempName
Worksheets("Sheet1").Cells(1, 1) = fileName
Set flOb = Nothing
End Sub
h. Read a file contents char by char ...
Private Sub cmdFileOperations_Click()
Dim flOb As Object
Dim objFile As Object
Dim iDx As Long
Set flOb = CreateObject("Scripting.FileSystemObject")
Set objFile = flOb.OpenTextFile("C:\Documents and Settings\Admin\Desktop\New Folder\abcd.txt", 1, False)
iDx = 0
Do Until objFile.AtEndOfStream
iDx = iDx + 1
Worksheets("Sheet1").Cells(iDx, 1) = objFile.Read(1)
Loop
Set objFile = Nothing
Set flOb = Nothing
End Sub
i. Read a file contents to an array and display the contents from bottom to up ...
Private Sub cmdFileOperations_Click()
Dim flOb As Object
Dim objFile As Object
Dim iDx As Long, jDx As Long
Dim arrTextLines() As String
Set flOb = CreateObject("Scripting.FileSystemObject")
Set objFile = flOb.OpenTextFile("C:\Documents and Settings\Admin\Desktop\New Folder\abcd.txt", 1, False)
iDx = 0
Do Until objFile.AtEndOfStream
ReDim Preserve arrTextLines(iDx)
arrTextLines(iDx) = objFile.ReadLine
iDx = iDx + 1
Loop
jDx = 1
For iDx = UBound(arrTextLines) To 0 Step -1
Worksheets("Sheet1").Cells(jDx, 1) = arrTextLines(iDx)
jDx = jDx + 1
Next iDx
Set objFile = Nothing
Set flOb = Nothing
End Sub
j. Open a file into a browser (IE) ...
Private Sub cmdFileOperations_Click()
Set objShell = CreateObject("WScript.Shell")
objShell.Run ("Explorer" & " C:\Documents and Settings\Admin\Desktop\New Folder\abcd.txt")
End Sub
k. Open a file in Notepad ...
Private Sub cmdFileOperations_Click()
Dim dTaskID As Double, path As String, file As String
path = "C:\WINDOWS\notepad.exe"
file = "C:\Documents and Settings\Admin\Desktop\New Folder\abcd.txt"
dTaskID = Shell(path + " " + file, vbNormalFocus)
End Sub
l. Read a complete text file ...
Private Sub cmdFileOperations_Click()
Dim flOb As Object
Dim objFile As Object
Set flOb = CreateObject("Scripting.FileSystemObject")
Set objFile = flOb.OpenTextFile("C:\Documents and Settings\Admin\Desktop\New Folder\abcd.txt", 1, False)
Worksheets("Sheet1").Cells(1, 1) = objFile.ReadAll
Set objFile = Nothing
Set flOb = Nothing
End Sub
8. Working with Arrays...
a. Simple array...
Private Sub cmdArray_Click()
Dim arr(2) As String
Dim iDx As Integer
arr(0) = "Rajni Kanth"
arr(1) = "Kamal Hasan"
For iDx = 0 To 1
MsgBox arr(iDx)
Next iDx
End Sub
b. Dynamic array...
Private Sub cmdArray_Click()
Dim arr() As String
Dim iDx As Integer
For iDx = 0 To 4
ReDim arr(iDx + 1) As String
arr(iDx) = CStr(iDx + 1)
Next iDx
For iDx = 0 To 4
MsgBox arr(iDx)
Next iDx
End Sub
We do expect that the above code will result us "1 then 2 .... till 5". But it results blank values for the first four attempts and displays correctly just the fifth value which is 5. Why it is? Because we are redeclaring the array on each loop iteration, so the previous value is getting lost. So we have to preserve the existing values when we redeclare the array. Watch the below code...
c. Dynamic array (Preserve existing values)...
Private Sub cmdArray_Click()
Dim arr() As String
Dim iDx As Integer
For iDx = 0 To 4
ReDim Preserve arr(iDx + 1) As String
arr(iDx) = CStr(iDx + 1)
Next iDx
For iDx = 0 To 4
MsgBox arr(iDx)
Next iDx
End Sub
9. Working with existing Excel files
a. Add data to cells...
Private Sub cmdExcel_Click()
Dim exInp As Excel.Application
Dim inpSht As Excel.Worksheet
Set exInp = New Excel.Application
exInp.Workbooks.Open "C:\Apps\Ramamoorthy\Input.xls", , ReadOnly:=False
Set inpSht = exInp.Worksheets("Sheet1") 'Or exInp.Worksheets(1)
inpSht.Cells(1, 1) = "One, One"
inpSht.Cells(2, 1) = "Two, One"
inpSht.Cells(3, 1) = "Three, One"
Set inpSht = Nothing
exInp.Workbooks(1).Save
exInp.Workbooks.Close
End Sub
b. Rename, Remove worksheets...
Private Sub cmdExcel_Click()
Dim exInp As Excel.Application
Dim inpSht As Excel.Worksheet
Set exInp = New Excel.Application
exInp.Workbooks.Open "C:\Apps\Ramamoorthy\Input.xls", , ReadOnly:=False
Set inpSht = exInp.Worksheets("Sheet1")
inpSht.Name = "One"
exInp.Worksheets("Sheet2").Name = "Two"
exInp.Worksheets("Sheet3").Delete
Set inpSht = Nothing
exInp.Workbooks(1).Save
exInp.Workbooks.Close
End Sub
c. Avoid alerts when deleting a worksheet...
Private Sub cmdExcel_Click()
Dim exInp As Excel.Application
Dim inpSht As Excel.Worksheet
Set exInp = New Excel.Application
exInp.DisplayAlerts = False
exInp.Workbooks.Open "C:\Apps\Ramamoorthy\Input.xls", , ReadOnly:=False
Set inpSht = exInp.Worksheets("Sheet1")
inpSht.Delete
Set inpSht = Nothing
exInp.Workbooks(1).Save
exInp.Workbooks.Close
End Sub
d. Add a new worksheet...
Private Sub cmdExcel_Click()
Dim exInp As Excel.Application
Dim inpSht As Excel.Worksheet
Set exInp = New Excel.Application
exInp.DisplayAlerts = False
exInp.Workbooks.Open "C:\Apps\Ramamoorthy\Input.xls", , ReadOnly:=False
Set inpSht = exInp.Worksheets.Add
inpSht.Name = "Newly Added"
inpSht.Cells(1, 1) = "This is new sheet!"
Set inpSht = Nothing
exInp.Workbooks(1).Save
exInp.Workbooks.Close
End Sub
e. Add three worksheets but after a specific sheet...
Here assume that there are two existing sheets (One, Two). Now lets add three more sheets Three, Four, Five. See the below code.
Private Sub cmdExcel_Click()
Dim exInp As Excel.Application
Dim shtCount As Integer
Set exInp = New Excel.Application
exInp.DisplayAlerts = False
exInp.Workbooks.Open "C:\Apps\Ramamoorthy\Input.xls", , ReadOnly:=False
shtCount = exInp.Worksheets.Count
exInp.Worksheets.Add , After:=exInp.Worksheets("Two"), Count:=3
exInp.Worksheets(shtCount + 1).Name = "Three"
exInp.Worksheets(shtCount + 2).Name = "Four"
exInp.Worksheets(shtCount + 3).Name = "After"
exInp.Workbooks(1).Save
exInp.Workbooks.Close
End Sub
f. Add a new worksheet as first sheet...
Private Sub cmdExcel_Click()
Dim exInp As Excel.Application
Set exInp = New Excel.Application
exInp.DisplayAlerts = False
exInp.Workbooks.Open "C:\Apps\Ramamoorthy\Input.xls", , ReadOnly:=False
exInp.Worksheets.Add Before:=exInp.Worksheets(1), Count:=1
'Or exInp.Worksheets.Add Before:=exInp.Worksheets("One"), Count:=1
exInp.Worksheets(1).Name = "First"
exInp.Workbooks(1).Save
exInp.Workbooks.Close
End Sub
g. Check whether a work sheet exists or not...
Private Sub cmdExcel_Click()
Dim exInp As Excel.Application
Set exInp = New Excel.Application
exInp.Workbooks.Open "C:\Apps\Ramamoorthy\Input.xls", , ReadOnly:=True
If Len(exInp.Worksheets("One1").Name) > 0 Then
MsgBox exInp.Worksheets("One1").Cells(1, 1)
Else
MsgBox "Sheet doesn't exist!"
End If
exInp.Workbooks.Close
End Sub
10. Create a new work book and add values...
Private Sub cmdExcel_Click()
Dim exInp As Excel.Application
Dim Inp As Excel.Workbook
Dim bookName As String
Set exInp = New Excel.Application
Set Inp = exInp.Workbooks.Add
bookName = Inp.Name
exInp.DisplayAlerts = False
Inp.Worksheets("Sheet1").Name = "Sum"
Inp.Worksheets("Sum").Cells(1, 1) = 1
Inp.Worksheets("Sum").Cells(2, 1) = 2
Inp.Worksheets("Sum").Cells(3, 1) = 3
Inp.Worksheets("Sum").Cells(4, 1) = "=SUM(A1:A3)"
Inp.Worksheets("Sheet2").Delete
Inp.Worksheets("Sheet3").Delete
exInp.Workbooks(bookName).SaveAs "C:\Apps\Ramamoorthy\Output.xls"
End Sub
Keep watch this space. You will learn lot on Excel Macro programming...
Contact me with all your Suggestions, Complaints, Queries, Ideas etc.
Email : nallananban@gmail.com / heyhelloram@yahoo.com
No comments:
Post a Comment