Saturday 29 August 2015

Working with Excel: add sheets, delete sheets, sort worksheets by name, worksheet count, create workbook..

'' 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)

No comments:

Post a Comment