Monday, March 19, 2018

Excel Opertions in VBS

Create Excelsheet
===============
'Bind to the Excel object
Set objExcel = CreateObject("Excel.Application")

'Create a new workbook.
objExcel.Workbooks.Add

'Select the first sheet
Sheet = 1

'Bind to worksheet.
Set objSheet = objExcel.ActiveWorkbook.Worksheets(Sheet)

'Name the worksheet
objSheet.Name = "VBS_Excel_Example"

'Set the save location
strExcelPath = "C:\Users\Administrator\Desktop\Excel POC\generated excel\Vbs_Excel_Example.xlsx"
'--------------------------------------------------------
'Populate the worksheet with data
'--------------------------------------------------------
'   objSheet.Cells(row, column).Value = "Whatever"

'Add some titles to row 1
objSheet.Cells(1, 1).Value = "Name" 'Row 1 Column 1 (A)
objSheet.Cells(1, 2).Value = "Description" 'Row 1 Column 2 (B)
objSheet.Cells(1, 3).Value = "Something Else" 'Row 1 Column 3 (C)

'Add some data using a loop
For row = 2 to 10
objSheet.Cells(row, 1).Value = "Item " & row & " Name"
objSheet.Cells(row, 2).Value = "Item " & row & " Description"
objSheet.Cells(row, 3).Value = "Item " & row & " Something Else"
Next

'--------------------------------------------------------
' Format the spreadsheet
'--------------------------------------------------------

'Put the first row in bold
objSheet.Range("A1:C1").Font.Bold = True

'Change the font size of the first row to 14
objSheet.Range("A1:C1").Font.Size = 14

'Freeze the panes
objSheet.Range("A2").Select
objExcel.ActiveWindow.FreezePanes = True

'Change column A and B to use a fixed width
objExcel.Columns(1).ColumnWidth = 20
objExcel.Columns(2).ColumnWidth = 30

'Change column C to autofit
objExcel.Columns(3).AutoFit()

'Change the background colour of column A to a light yellow
objExcel.Columns(1).Interior.ColorIndex = 36

'Change the font colour of column C to blue
objExcel.Columns(3).Font.ColorIndex = 5


'--------------------------------------------------------
' Save the spreadsheet and close the workbook
'--------------------------------------------------------
objExcel.ActiveWorkbook.SaveAs strExcelPath
objExcel.ActiveWorkbook.Close

'Quit Excel
objExcel.Application.Quit

'Clean Up
Set objSheet = Nothing
Set objExcel = Nothing

Update Excelsheet
==================
Const xlShiftToRight = -4161
Const xlup = -4162
'create the excel object
Set objExcel = CreateObject("Excel.Application")

'view the excel program and file, set to false to hide the whole process
objExcel.Visible = True

'open an excel file (make sure to change the location) .xls for 2003 or earlier
Set objWorkbook = objExcel.Workbooks.Open("C:\Users\Administrator\Desktop\Excel POC\generated excel\Vbs_Excel_Example.xlsx")

Set objRange = objExcel.Range("A1").EntireColumn
objRange.Insert(xlShiftToRight)

'Add some titles to row 1
objExcel.Cells(1, 1).Value = "Concatenated Column" 'Row 1 Column 1 (A)

For i = 2 To objExcel.Cells(objExcel.Rows.Count, "B").End(xlup).Row
    objExcel.Cells(i, "A").Value = objExcel.Cells(i, "B").Value & "_" & objExcel.Cells(i, "D").Value
Next

'Put the first row in bold
objExcel.Range("A1:C1").Font.Bold = True

'Change the font size of the first row to 14
objExcel.Range("A1:C1").Font.Size = 14

objExcel.Columns(1).AutoFit()

'save the existing excel file. use SaveAs to save it as something else
objWorkbook.Save

'close the workbook
objWorkbook.Close

'exit the excel program
objExcel.Quit

'release objects
Set objExcel = Nothing
Set objWorkbook = Nothing

Copy Data from one excel to another
==============================
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
Set objWorkbook = objExcel.Workbooks.Open("C:\Users\HP\Desktop\Excelsheets\Vbs_Excel_Example.xlsx")
Set objWorkbook2 = objExcel.Workbooks.Open("C:\Users\HP\Desktop\Excelsheets\Vbs_Excel_Example1.xlsx")

Set objWorksheet = objWorkbook.Worksheets(1)
objWorksheet.Activate

'Set objRange = objWorkSheet.Range("A1").EntireColumn
'Set objRange = objWorkSheet.Range("B1").EntireColumn
'objRange.Copy
Set aCell = objWorksheet.Rows(1).Find("Subnet Name",,,1)

If Not aCell Is Nothing Then
       'MsgBox "Value Found in Cell " & aCell.Address & _
        '" and the Cell Column Number is " & aCell.Column
Dim colLetter = Replace(objWorkSheet.Cells(1, aCell.Column).Address(False, False), "1", "")
MsgBox(colLetter)
objWorkSheet.Range(colLetter).EntireColumn.Copy
End If

'objWorkSheet.Range("C:D").EntireColumn.Copy


Set objWorksheet2 = objWorkbook2.Worksheets(1)
objWorksheet.Activate

'Set finalcolumn  =  1 + objWorksheet2.Cells(1, 1).End(-4161).Column
'MsgBox(objWorksheet2.UsedRange.Columns(objWorksheet2.UsedRange.Columns.Count).Column) 
'To Find Last Column Letter
'MsgBox Replace(objWorksheet2.Cells(1, objWorksheet2.UsedRange.Columns(objWorksheet2.UsedRange.Columns.Count).Column+1).Address(False, False), "1", "")

objWorkSheet2.Paste objWorkSheet2.Range(Replace(objWorksheet2.Cells(1, objWorksheet2.UsedRange.Columns(objWorksheet2.UsedRange.Columns.Count).Column+1).Address(False, False), "1", "")&"1")

objWorkbook2.Save

'close the workbook
objWorkbook2.Close

'exit the excel program
objExcel.Quit

Set objExcel = Nothing
Set objWorkbook2 = Nothing



No comments:

Post a Comment