Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
?
Solved

VBScript, XLS, Formattting and other Functions

Posted on 2008-11-14
2
Medium Priority
?
766 Views
Last Modified: 2012-05-05
Hello, does anyone have a list of properties that you can change when writing a XLS file from VBScripting?  Thing I am interested...

How to write to multiple sheets in the same file... Say a new page per server, but in the same xls.
How to change the cell colors
How to change font, font size, font color

If there is a reference with the entire list properties, it'd be great.
0
Comment
Question by:mmitchell57
2 Comments
 
LVL 18

Accepted Solution

by:
exx1976 earned 500 total points
ID: 22963880
Below are some functions I've written to do varous things in Excel.  I have hundreds more, but they're scattered across as many scripts, and I don't have time to go dig them up.  These should get you started.

If you're unsure how to do something, jsut record a macro of you doing it in the GUI, then save the macro, and then view the macro code.  VBA is similar to VBS, you should be able to figure out how to make it work.

HTH,
exx
Const xlCenter = &hffffeff4
Const xlLeft = &hffffefdd
Const xlRight = &hffffefc8
Const xlBottom = &hffffeff5
Const xlTop = &hffffefc0
Const xlInsideHorizontal = 12
Const xlInsideVertical = 11
Const xlDiagonalDown = 5
Const xlDiagonalUp = 6
Const xlEdgeBottom = 9
Const xlEdgeRight = 10
Const xlEdgeLeft = 7
Const xlEdgeTop = 8
Const xlNone = &hffffefd2
Const xlThin = 2
Const xlContinuous = 1
Const xlMedium = &hffffefd6
Const xlUnderlineStyleSingle = 2
Const xlAscending = 1
Const xlNo = 2
Const xlDescending = 2
 
 
Sub Underline(sheetNumber, underlineStyle, cells)
	On Error Resume Next
	arr = Split(cells,":",-1,1)
	Set sheet = oExcelApp.ActiveWorkBook.Worksheets(sheetNumber)
	If arr(0) = arr(1) Then
		Set oRange = sheet.Range(arr(0))
	Else
		Set oRange = sheet.Range(arr(0), arr(1))
	End If
	oRange.Font.Underline = underlineStyle
End Sub
 
Sub Sort(sheetNumber, cells, key, direction, header)
 On Error Resume Next
 
 arr = Split(cells,":",-1,1)
 Set sheet = oExcelApp.ActiveWorkbook.Worksheets(sheetNumber)
 If arr(0) = arr(1) Then
  Exit Sub
 Else
  Set oRange = sheet.Range(arr(0), arr(1))
  Set oRangeKey = oExcelApp.Range(key)
  oRange.Sort oRangeKey,direction,,,,,,header
 End If
End Sub
 
Sub AccountingFormat(sheetNumber, cells)
	On Error Resume Next
	arr = Split(cells,":",-1,1)
	Set sheet = oExcelApp.ActiveWorkBook.Worksheets(sheetNumber)
	If arr(0) = arr(1) Then
		Set oRange = sheet.Range(arr(0))
	Else
		Set oRange = sheet.Range(arr(0), arr(1))
	End If
	oRange.NumberFormat = "_(* #,##0.00_);_(* (#,##0.00);_(* ""-""??_);_(@_)"
End Sub
 
Sub MoneyFormat(sheetNumber, cells)
	On Error Resume Next
	arr = Split(cells,":",-1,1)
	Set sheet = oExcelApp.ActiveWorkBook.Worksheets(sheetNumber)
	If arr(0) = arr(1) Then
		Set oRange = sheet.Range(arr(0))
	Else
		Set oRange = sheet.Range(arr(0), arr(1))
	End If
	oRange.NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"
End Sub
 
Sub TextFormat(sheetNumber, cells)
	On Error Resume Next
	arr = Split(cells,":",-1,1)
	Set sheet = oExcelApp.ActiveWorkBook.Worksheets(sheetNumber)
	If arr(0) = arr(1) Then
		Set oRange = sheet.Range(arr(0))
	Else
		Set oRange = sheet.Range(arr(0), arr(1))
	End If
	oRange.NumberFormat = "@"
End Sub
 
Sub PercentFormat(sheetNumber, cells)
	On Error Resume Next
	arr = Split(cells,":",-1,1)
	Set sheet = oExcelApp.ActiveWorkBook.Worksheets(sheetNumber)
	If arr(0) = arr(1) Then
		Set oRange = sheet.Range(arr(0))
	Else
		Set oRange = sheet.Range(arr(0), arr(1))
	End If
	oRange.NumberFormat = "0.00%"
End Sub
 
Sub BorderBoxOutside(sheetNumber, weight, cells)
	On Error Resume Next
	Border sheetNumber, xlDiagonalUp, xlNone, cells
	Border sheetNumber, xlDiagonalDown, xlNone, cells
	Border sheetNumber, xlEdgeLeft, xlContinuous, cells
	Border sheetNumber, xlEdgeTop, xlContinuous, cells
	Border sheetNumber, xlEdgeRight, xlContinuous, cells
	Border sheetNumber, xlEdgeBottom, xlContinuous, cells
	BorderWeight sheetNumber, xlEdgeLeft, Weight, cells
	BorderWeight sheetNumber, xlEdgeTop, Weight, cells
	BorderWeight sheetNumber, xlEdgeRight, Weight, cells
	BorderWeight sheetNumber, xlEdgeBottom, Weight, cells
End Sub
 
Sub BorderBox(sheetNumber, weight, cells)
	On Error Resume Next
	Border sheetNumber, xlDiagonalUp, xlNone, cells
	Border sheetNumber, xlDiagonalDown, xlNone, cells
	Border sheetNumber, xlEdgeLeft, xlContinuous, cells
	Border sheetNumber, xlEdgeTop, xlContinuous, cells
	Border sheetNumber, xlEdgeRight, xlContinuous, cells
	Border sheetNumber, xlEdgeBottom, xlContinuous, cells
	Border sheetNumber, xlInsideVertical, xlContinuous, cells
	Border sheetNumber, xlInsideHorizontal, xlContinuous, cells
	BorderWeight sheetNumber, xlEdgeLeft, Weight, cells
	BorderWeight sheetNumber, xlEdgeTop, Weight, cells
	BorderWeight sheetNumber, xlEdgeRight, Weight, cells
	BorderWeight sheetNumber, xlEdgeBottom, Weight, cells
	BorderWeight sheetNumber, xlInsideVertical, Weight, cells
	BorderWeight sheetNumber, xlInsideHorizontal, Weight, cells
End Sub
 
Sub Border(sheetNumber, alignment, lineStyle, cells)
	On Error Resume Next
	arr = Split(cells,":",-1,1)
	Set sheet = oExcelApp.ActiveWorkBook.Worksheets(sheetNumber)
	If arr(0) = arr(1) Then
		Set oRange = sheet.Range(arr(0))
	Else
		Set oRange = sheet.Range(arr(0), arr(1))
	End If
	oRange.Borders(alignment).LineStyle = lineStyle
End Sub
 
Sub BorderWeight(sheetNumber, alignment, weight, cells)
	On Error Resume Next
	arr = Split(cells,":",-1,1)
	Set sheet = oExcelApp.ActiveWorkBook.Worksheets(sheetNumber)
	If arr(0) = arr(1) Then
		Set oRange = sheet.Range(arr(0))
	Else
		Set oRange = sheet.Range(arr(0), arr(1))
	End If
	oRange.Borders(alignment).Weight = Weight
End Sub
 
Sub FontColor(sheetNumber, colorOfFont, cells)
	On Error Resume Next
	arr = Split(cells,":",-1,1)
	Set sheet = oExcelApp.ActiveWorkBook.Worksheets(sheetNumber)
	If arr(0) = arr(1) Then
		Set oRange = sheet.Range(arr(0))
	Else
		Set oRange = sheet.Range(arr(0), arr(1))
	End If
	oRange.Font.ColorIndex = colorOfFont
End Sub
 
Sub Bold(sheetNumber, cells)
	On Error Resume Next
	arr = Split(cells,":",-1,1)
	Set sheet = oExcelApp.ActiveWorkBook.Worksheets(sheetNumber)
	If arr(0) = arr(1) Then
		Set oRange = sheet.Range(arr(0))
	Else
		Set oRange = sheet.Range(arr(0), arr(1))
	End If
	oRange.Font.Bold = True
End Sub
 
Sub FontName(sheetNumber, nameOfFont, cells)
	On Error Resume Next
	arr = Split(cells,":",-1,1)
	Set sheet = oExcelApp.ActiveWorkBook.Worksheets(sheetNumber)
	If arr(0) = arr(1) Then
		Set oRange = sheet.Range(arr(0))
	Else
		Set oRange = sheet.Range(arr(0), arr(1))
	End If
	oRange.Font.Name = nameOfFont
End Sub
 
Sub FontSize(sheetNumber, sizeOfFont, cells)
	On Error Resume Next
	arr = Split(cells,":",-1,1)
	Set sheet = oExcelApp.ActiveWorkBook.Worksheets(sheetNumber)
	If arr(0) = arr(1) Then
		Set oRange = sheet.Range(arr(0))
	Else
		Set oRange = sheet.Range(arr(0), arr(1))
	End If
	oRange.Font.Size = sizeOfFont
End Sub
 
Sub Horizontal(sheetNumber, alignment, cells)
	On Error Resume Next
	arr = Split(cells,":",-1,1)
	Set sheet = oExcelApp.ActiveWorkBook.Worksheets(sheetNumber)
	If arr(0) = arr(1) Then
		Set oRange = sheet.Range(arr(0))
	Else
		Set oRange = sheet.Range(arr(0), arr(1))
	End If
	oRange.horizontalAlignment = alignment
End Sub
 
Sub Vertical(sheetNumber, alignment, cells)
	On Error Resume Next
	arr = Split(cells,":",-1,1)
	Set sheet = oExcelApp.ActiveWorkBook.Worksheets(sheetNumber)
	If arr(0) = arr(1) Then
		Set oRange = sheet.Range(arr(0))
	Else
		Set oRange = sheet.Range(arr(0), arr(1))
	End If
	oRange.verticalAlignment = alignment
End Sub
 
Sub Merge(sheetNumber, cells)
	On Error Resume Next
	arr = Split(cells,":",-1,1)
	Set sheet = oExcelApp.ActiveWorkBook.Worksheets(sheetNumber)
	If arr(0) = arr(1) Then
		Set oRange = sheet.Range(arr(0))
	Else
		Set oRange = sheet.Range(arr(0), arr(1))
	End If
	oRange.Merge
End Sub
 
Sub Write(sheetNumber, data, cells)
	On Error Resume Next
	arr = Split(cells,":",-1,1)
	Set sheet = oExcelApp.ActiveWorkBook.Worksheets(sheetNumber)
	If arr(0) = arr(1) Then
		Set oRange = sheet.Range(arr(0))
	Else
		Set oRange = sheet.Range(arr(0), arr(1))
	End If
	oRange.FormulaR1C1 = data
End Sub
 
Sub ColorCells(sheetNumber, colorIndex, cells)
	On Error Resume Next
	arr = Split(cells,":",-1,1)
	Set sheet = oExcelApp.ActiveWorkBook.Worksheets(sheetNumber)
	If arr(0) = arr(1) Then
		Set oRange = sheet.Range(arr(0))
	Else
		Set oRange = sheet.Range(arr(0), arr(1))
	End If
	oRange.Interior.ColorIndex = colorIndex
End Sub
 
Sub WrapText(SheetNumber, cells)
	On Error Resume Next
	arr = Split(cells,":",-1,1)
	Set sheet = oExcelApp.ActiveWorkBook.Worksheets(sheetNumber)
	If arr(0) = arr(1) Then
		Set oRange = sheet.Range(arr(0))
	Else
		Set oRange = sheet.Range(arr(0), arr(1))
	End If
	oRange.WrapText = True
End Sub

Open in new window

0
 

Author Closing Comment

by:mmitchell57
ID: 31516948
Thank you for the hint about Macro's. That will help out quite a bit. Also, thank you for all the snippets. :)
0

Featured Post

Free Tool: Subnet Calculator

The subnet calculator helps you design networks by taking an IP address and network mask and returning information such as network, broadcast address, and host range.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Recently I finished a vbscript that I thought I'd share.  It uses a text file with a list of server names to loop through and get various status reports, then writes them all into an Excel file.  Originally it was put together for our Altiris server…
When it comes to writing scripts for a Client/Server computing environment it is essential to consider some way of enabling the authentication functionality within a script. This sort of consideration mainly comes into the picture when we are dealin…
Look below the covers at a subform control , and the form that is inside it. Explore properties and see how easy it is to aggregate, get statistics, and synchronize results for your data. A Microsoft Access subform is used to show relevant calcul…
As many of you are aware about Scanpst.exe utility which is owned by Microsoft itself to repair inaccessible or damaged PST files, but the question is do you really think Scanpst.exe is capable to repair all sorts of PST related corruption issues?
Suggested Courses

578 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question