KEMBAR78
VBA Code To Generate Report | PDF
Scribd
Upload
144 views3 pages

VBA Code To Generate Report

The document contains a VBA script that creates a test environment in Excel with two sheets: one for reports and another for student data. It populates the student sheet with names and grades, then processes each student's grade to generate a visual report using ovals. The script includes functions to clear the report and handle invalid grades, ensuring a fresh report for each student processed.

Uploaded by

Adesola Oladipo
Copyright
© © All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as DOCX, PDF, TXT or read online on Scribd
144 views3 pages

VBA Code To Generate Report

The document contains a VBA script that creates a test environment in Excel with two sheets: one for reports and another for student data. It populates the student sheet with names and grades, then processes each student's grade to generate a visual report using ovals. The script includes functions to clear the report and handle invalid grades, ensuring a fresh report for each student processed.

Uploaded by

Adesola Oladipo
Copyright
© © All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as DOCX, PDF, TXT or read online on Scribd
You are on page 1/ 3

Const ReportSheet = "Report"

Const StudentNames = "Students"

Sub CreateEnvironment() ' makes a test environment

With ThisWorkbook.Sheets.Add ' new report worksheet

.Name = ReportSheet

.Rows(1).RowHeight = 20

End With

With ThisWorkbook.Sheets.Add ' data sheet & test data

.Name = StudentNames

.Range("A1:B1") = Array("Name", "Grade")

.Range("A2:B2") = Array("Norma", "A")

.Range("A3:B3") = Array("Fred", "No Show")

.Range("A4:B4") = Array("Perry", "Inc.")

.Range("A5:B5") = Array("Jane", "")

End With

End Sub

'==========================================

' Cycle through names and modifies report

'

Sub main()

Application.ScreenUpdating = False

Dim i As Long
With Sheets(StudentNames)

For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row

DoOval i

Sheets(ReportSheet).[B][COLOR=#0000cd]PrintOut[/COLOR][/B]

Next i

End With

ClearReport 'Clears report worksheet

Application.ScreenUpdating = True

End Sub

Sub DoOval(irow)

Dim grades

grades = Array("A", "B", "C", "D", "D-", "E", "Inc.") ' array of possible grades

Dim g, ag

On Local Error Resume Next

Sheets(ReportSheet).Activate

ClearReport

For g = 0 To UBound(grades) ' Fill in possible grades

Cells(1, g + 1) = grades(g)

Cells(1, g + 1).HorizontalAlignment = xlCenter

Cells(1, g + 1).VerticalAlignment = xlCenter

Cells(2, 1) = Sheets(StudentNames).Cells(irow, 1)

If UCase(grades(g)) = UCase(Sheets(StudentNames).Cells(irow, 2)) Then ag = g + 1

Next g

If IsEmpty(ag) Then ' grade is invalid

Application.Intersect(Rows(1), Cells(1, 1).CurrentRegion).ClearContents


Cells(1, 1) = "N/A"

ag = 1

End If

With Cells(1, ag)

ActiveSheet.Shapes.AddShape(msoShapeOval, .Left, .Top, .Width, .Height).Select

End With

With Selection

.Name = "GradeOval"

.ShapeRange.Fill.Visible = msoFalse

.ShapeRange.Line.ForeColor.SchemeColor = 12

.ShapeRange.Line.Weight = 2

End With

Cells(2, 1).Activate

End Sub

Sub ClearReport()

On Local Error Resume Next

ActiveSheet.Shapes("GradeOval").Cut ' get rid of previous oval

ActiveSheet.Cells.ClearContents ' get rid of report text

End Sub

You might also like