'' Working with Excel: add sheets, delete sheets, sort worksheets by name, worksheet count, create workbook..
'1. Create Excel and save it
'2. Add worksheets 3
'3. sort worksheets
'4. Delete specific sheet
'5. Count Total number of sheets
spath="C:\Users\gvenu\Desktop\rngtones\v.xls"
ch=InputBox("Please enter your choice: "_
& vbNewLine &"1. CreateExcel"_
& vbNewLine &"2. AddWorksheets"_
& vbNewLine &"3. SortWorksheets"_
& vbNewLine &"4. DeleteSheets")
Set oex=CreateObject("Excel.Application")
Set fso=CreateObject("Scripting.FileSystemObject")
oex.Application.Visible= True
Select Case ch
Case "1" '' Create a new workbook
on error resume next
if not fso.FileExists(spath) then
oex.Application.Visible= True
oex.Workbooks.Add()
oex.ActiveWorkbook.SaveAs(spath)
Else
msgbox "File already exist"
End If
on error goto 0
Case "2" '' Add 5 worksheets
oex.Application.Visible= True
Set wb=oex.Workbooks.Open(spath)
set ws=wb.Worksheets(3)
set ads=wb.Sheets
ads.Add ws, , 5
set wb=Nothing
Case "3" '3. sort worksheets
Set wb=oex.Workbooks.Open(spath)
MsgBox "Worksheets count: "& oex.Worksheets.Count
Dim sht()
i=0
'' Get the sheet names
For Each sh In wb.Sheets
ReDim Preserve sht(i)
sht(i)=sh.Name
i=i+1
Next
MsgBox "Sheet names before sorting:" & Join(sht)
'' Array of sheet names sorting..
MaxShName=sht(0)
for i=UBound(sht) To 0 Step -1
For j=0 To i-1
If sht(j)>sht(j+1) Then
temp=sht(j)
sht(j)=sht(j+1)
sht(j+1)=temp
End If
Next
Next
MsgBox "Sheet names after sorting:" & Join(sht) &vbNewLine & "Sheets sorted successfully!!"
For i = UBound(sht) to 1 Step -1
Set objSheet1 = oex.Sheets(sht(i))
Set objSheet2 = oex.Sheets(sht(i-1))
objSheet2.Move objSheet1
Next
Case "4" '4. Delete specific sheet
Set wb=oex.Workbooks.Open(spath)
MsgBox "Worksheets count: "& oex.Worksheets.Count
MsgBox wb.Sheets(1).name '' another way to access sheetname
For i=1 To oex.Worksheets.Count
If StrComp(wb.Sheets(i).name, "sheet3", 1)=0 Then '' Here "sheet3" is the sheet name
wb.Worksheets(i).Delete '' Worksheet deleted successfully!!
Exit For
End If
Next
' Dim sht()
' i=0
' For Each sh In wb.Sheets
' ReDim Preserve sht(i)
' sht(i)=sh.Name
' i=i+1
' Next
End Select
oex.Quit
Set oex= Nothing
=================================
'' To create a workbook with total 12 worksheets:
Set objWorkbook = objExcel.Workbooks.Add()
Set objWorksheet = objWorkbook.Worksheets(3)
Set colSheets = objWorkbook.Sheets
colSheets.Add objWorksheet,,9
============================
'' To delete all the worksheets except one:
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.DisplayAlerts = False
Set objWorkbook = objExcel.Workbooks.Open("C:\Users\gvenu\Desktop\rngtones\test3.xlsx")
i = objWorkbook.Worksheets.Count
Do Until i = 1
objWorkbook.Worksheets(i).Delete
i = i - 1
Loop
=============================
Function GetAbsolutePath()
Set objFSO = CreateObject("Scripting.FileSystemObject")
vBaseDir = objFSO.GetAbsolutePathName(".")
GetAbsolutePath = vBaseDir
Set objFSO = Nothing
End Function
'MsgBox GetAbsolutePath()
==============================
'' Array Sorting
a=Array("venu", "g", "K", "G")
MsgBox Join(a)
ub=UBound(a)
For i=ub To 0 Step -1
For j=0 To i-1
If a(j)> a(j+1) Then
temp= a(j)
a(j)=a(j+1)
a(j+1)=temp
End If
Next
Next
MsgBox Join(a)
'2. Add worksheets 3
'3. sort worksheets
'4. Delete specific sheet
'5. Count Total number of sheets
spath="C:\Users\gvenu\Desktop\rngtones\v.xls"
ch=InputBox("Please enter your choice: "_
& vbNewLine &"1. CreateExcel"_
& vbNewLine &"2. AddWorksheets"_
& vbNewLine &"3. SortWorksheets"_
& vbNewLine &"4. DeleteSheets")
Set oex=CreateObject("Excel.Application")
Set fso=CreateObject("Scripting.FileSystemObject")
oex.Application.Visible= True
Select Case ch
Case "1" '' Create a new workbook
on error resume next
if not fso.FileExists(spath) then
oex.Application.Visible= True
oex.Workbooks.Add()
oex.ActiveWorkbook.SaveAs(spath)
Else
msgbox "File already exist"
End If
on error goto 0
Case "2" '' Add 5 worksheets
oex.Application.Visible= True
Set wb=oex.Workbooks.Open(spath)
set ws=wb.Worksheets(3)
set ads=wb.Sheets
ads.Add ws, , 5
set wb=Nothing
Case "3" '3. sort worksheets
Set wb=oex.Workbooks.Open(spath)
MsgBox "Worksheets count: "& oex.Worksheets.Count
Dim sht()
i=0
'' Get the sheet names
For Each sh In wb.Sheets
ReDim Preserve sht(i)
sht(i)=sh.Name
i=i+1
Next
MsgBox "Sheet names before sorting:" & Join(sht)
'' Array of sheet names sorting..
MaxShName=sht(0)
for i=UBound(sht) To 0 Step -1
For j=0 To i-1
If sht(j)>sht(j+1) Then
temp=sht(j)
sht(j)=sht(j+1)
sht(j+1)=temp
End If
Next
Next
MsgBox "Sheet names after sorting:" & Join(sht) &vbNewLine & "Sheets sorted successfully!!"
For i = UBound(sht) to 1 Step -1
Set objSheet1 = oex.Sheets(sht(i))
Set objSheet2 = oex.Sheets(sht(i-1))
objSheet2.Move objSheet1
Next
Case "4" '4. Delete specific sheet
Set wb=oex.Workbooks.Open(spath)
MsgBox "Worksheets count: "& oex.Worksheets.Count
MsgBox wb.Sheets(1).name '' another way to access sheetname
For i=1 To oex.Worksheets.Count
If StrComp(wb.Sheets(i).name, "sheet3", 1)=0 Then '' Here "sheet3" is the sheet name
wb.Worksheets(i).Delete '' Worksheet deleted successfully!!
Exit For
End If
Next
' Dim sht()
' i=0
' For Each sh In wb.Sheets
' ReDim Preserve sht(i)
' sht(i)=sh.Name
' i=i+1
' Next
End Select
oex.Quit
Set oex= Nothing
=================================
'' To create a workbook with total 12 worksheets:
Set objWorkbook = objExcel.Workbooks.Add()
Set objWorksheet = objWorkbook.Worksheets(3)
Set colSheets = objWorkbook.Sheets
colSheets.Add objWorksheet,,9
============================
'' To delete all the worksheets except one:
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.DisplayAlerts = False
Set objWorkbook = objExcel.Workbooks.Open("C:\Users\gvenu\Desktop\rngtones\test3.xlsx")
i = objWorkbook.Worksheets.Count
Do Until i = 1
objWorkbook.Worksheets(i).Delete
i = i - 1
Loop
=============================
Function GetAbsolutePath()
Set objFSO = CreateObject("Scripting.FileSystemObject")
vBaseDir = objFSO.GetAbsolutePathName(".")
GetAbsolutePath = vBaseDir
Set objFSO = Nothing
End Function
'MsgBox GetAbsolutePath()
==============================
'' Array Sorting
a=Array("venu", "g", "K", "G")
MsgBox Join(a)
ub=UBound(a)
For i=ub To 0 Step -1
For j=0 To i-1
If a(j)> a(j+1) Then
temp= a(j)
a(j)=a(j+1)
a(j+1)=temp
End If
Next
Next
MsgBox Join(a)
No comments:
Post a Comment