Blog

Problem

There is a web based “course-structure” data downloading system. The university uses the system time to time to generate report.The downloaded data are in excel format as shown in the figure 1. Design a VBA script to make the data more readable format as shown in the figure 2.

FIGURE1

 

Figure 1: Initial excel sheet after downloading from the web application.

FIGURE2

Figure 2. The proposed output format of the figure 1.
Sub create_formated_report()

Dim i As Integer
Dim j As Integer
Dim k As Integer

Dim subtitle As String
Dim subcode As String
Dim subcodetemp As String
Dim printrng As String

Dim session As String
Dim semester As String

Sheets(1).Select
Sheets(1).Name = “MAIN”

shtmain = “MAIN”
‘ Go to sheet main
‘Sheets(shtmain).Select

session = InputBox(“Enter session (16-17):”)
semester = UCase(InputBox(“Enter semester (string):”))

printrng = setrange(2, 2, “A”, “H”)
setheading_title (printrng)
printrng = setrange(3, 3, “A”, “B”)
setheading_title (printrng)
printrng = setrange(3, 3, “C”, “G”)
setheading_title (printrng)

printrng = setrange(4, 4, “A”, “B”)
setheading_title (printrng)
printrng = setrange(4, 4, “C”, “G”)
setheading_title (printrng)

printrng = setrange(5, 5, “A”, “B”)
setheading_title (printrng)
printrng = setrange(5, 5, “C”, “G”)
setheading_title (printrng)

printrng = setrange(6, 6, “A”, “B”)
setheading_title (printrng)
printrng = setrange(6, 6, “C”, “G”)
setheading_title (printrng)

printrng = setrange(7, 7, “A”, “B”)
setheading_title (printrng)
printrng = setrange(7, 7, “C”, “C”)
setheading_title (printrng)
Cells(7, 4) = session
Cells(7, 6) = semester
Cells(9, 8) = “”
Cells(9, 9) = “”

printrng = setrange(9, 9, “A”, “B”)
Call setvertical(printrng)
printrng = setrange(9, 9, “F”, “G”)
Call setvertical(printrng)

subcode = Cells(10, 2)
subcodetemp = “”

Sheets(shtmain).Select
j = 10 ‘First line of table containing relevant course data

‘ Loop through the excel sheet to count line number, i.e. record

Do While StrComp(subcode, subcodetemp, vbTextCompare) <> 0
j = j + 1
subcode = Cells(j, 2)
Loop

printrng = setrange(9, j, “A”, “G”)
Call setwapping(printrng)
printrng = setrange(10, j, “A”, “A”)
Call setwidth(printrng, 5)
printrng = setrange(10, j, “B”, “B”)
Call setwidth(printrng, 10)
printrng = setrange(10, j, “C”, “D”)
Call setwidth(printrng, 27)
Call autofitrngROW(printrng)
Call autofitrngCOL(printrng)
printrng = setrange(9, j, “A”, “G”)
Call setboundary(printrng)
printrng = setrange(1, j, “A”, “G”)
Call setfont(printrng)
‘ Set print in Portrait mode
Call setpageA4_ver1(“P”)    ‘Last past
End Sub

Subroutines:

1. To set the width of a column

Sub setwidth(pr As String, w As Integer)
Range(pr).Select
Selection.ColumnWidth = w
End Sub
2. Set text in vertical orientation

Sub setvertical(printrng As String)
Range(printrng).Select
With Selection
.HorizontalAlignment = xlCenter ‘xlGeneral
.VerticalAlignment = xlCenter ‘xlBottom
.WrapText = False
.Orientation = 90
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
End Sub

3. Routine to set headings

Sub setheading_title(printrng As String)
Range(printrng).Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
End Sub

4. Auto setting of column

Sub autofitrngCOL(printrng As String)
Range(printrng).EntireColumn.AutoFit
End Sub

5. Auto setting of row

Sub autofitrngROW(printrng As String)
Range(printrng).EntireRow.AutoFit
End Sub

Advertisements

Visual Basic for Applications (VBA)

Source: Visual Basic for Applications (VBA)

Problem: How to set your page format automatically using VBA so that print report can be generated without formatting the page through page setup.

To have a A4 size Portrait page with 0 margin around one can call the ActiveSheet object with PageSetup method one can call the following routine with ‘P’ option.

Sub setpageA4_ver1(typ As String) ‘typ = ‘L’ – Landscape , ‘P’ – Portrait

With ActiveSheet.PageSetup
.LeftHeader = “”
.CenterHeader = “”
.RightHeader = “”
.LeftFooter = “”
.CenterFooter = “”
.RightFooter = “”
.LeftMargin = Application.InchesToPoints(0) ‘Set left margin
.RightMargin = Application.InchesToPoints(0) ‘Set right margin
.TopMargin = Application.InchesToPoints(0.01) ‘Set top margin
.BottomMargin = Application.InchesToPoints(0.01) ‘Set bottom margin
.HeaderMargin = Application.InchesToPoints(0.01) ‘Set header margin
.FooterMargin = Application.InchesToPoints(0.01) ‘Set footer margin
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600 ‘Set print quality
.CenterHorizontally = False ‘True
.CenterVertically = False ‘True
Select Case typ
Case “L”
.Orientation = xlLandscape
Case “P”
.Orientation = xlPortrait
End Select

.Draft = False

.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.Text = “”
.EvenPage.CenterHeader.Text = “”
.EvenPage.RightHeader.Text = “”
.EvenPage.LeftFooter.Text = “”
.EvenPage.CenterFooter.Text = “”
.EvenPage.RightFooter.Text = “”
.FirstPage.LeftHeader.Text = “”
.FirstPage.CenterHeader.Text = “”
.FirstPage.RightHeader.Text = “”
.FirstPage.LeftFooter.Text = “”
.FirstPage.CenterFooter.Text = “”
.FirstPage.RightFooter.Text = “”
End With

End Sub

If you are interested to set margins around the page then values can be passed through the subroutine argument list.
For example, we can modify the above routine to suite the mentioned changes as follows:

Sub setpageA4_ver2(typ As String, lm as integer, rm as integer, tm as integer, bm as integer)  ‘typ = ‘L’ – Landscape , ‘P’ – Portrait

With ActiveSheet.PageSetup
.LeftHeader = “”
.CenterHeader = “”
.RightHeader = “”
.LeftFooter = “”
.CenterFooter = “”
.RightFooter = “”
.LeftMargin = Application.InchesToPoints(lm) ‘Set left margin – lm
.RightMargin = Application.InchesToPoints(rm) ‘Set right margin – rm
.TopMargin = Application.InchesToPoints(tm) ‘Set top margin – tm
.BottomMargin = Application.InchesToPoints(bm ‘Set bottom margin – bm
.HeaderMargin = Application.InchesToPoints(0.01) ‘Set header margin
.FooterMargin = Application.InchesToPoints(0.01) ‘Set footer margin
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600 ‘Set print quality
.CenterHorizontally = False ‘True
.CenterVertically = False ‘True
Select Case typ
Case “L”
.Orientation = xlLandscape
Case “P”
.Orientation = xlPortrait
End Select

.Draft = False

.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.Text = “”
.EvenPage.CenterHeader.Text = “”
.EvenPage.RightHeader.Text = “”
.EvenPage.LeftFooter.Text = “”
.EvenPage.CenterFooter.Text = “”
.EvenPage.RightFooter.Text = “”
.FirstPage.LeftHeader.Text = “”
.FirstPage.CenterHeader.Text = “”
.FirstPage.RightHeader.Text = “”
.FirstPage.LeftFooter.Text = “”
.FirstPage.CenterFooter.Text = “”
.FirstPage.RightFooter.Text = “”
End With

End Sub

Hope readers can understand the concept and use the method to suits into his/her specific requirements.