Imports Microsoft.Office.Interop.Excel
Imports Microsoft.Office.Tools.Ribbon
Public Class Ribbon1
Private Sub Ribbon1_Load(ByVal sender As System.Object, ByVal e As RibbonUIEventArgs) Handles MyBase.Load
End Sub
Private Sub Button1_Click(sender As Object, e As RibbonControlEventArgs) Handles Button1.Click
'Create application to the InputData
Dim InputXLApp As Excel.Application
InputXLApp = New Excel.Application
InputXLApp.Visible = True
'=================================
'Provide the path of input excel workbook through inputbox
Dim WkbPath As String
WkbPath = InputXLApp.InputBox("Provide the Excel Path", "www.Tricks12345.com")
'===============================
'Add workbook to the application
Dim InputWKB As Excel.Workbook
InputWKB = InputXLApp.Workbooks.Add(WkbPath)
'=====================================
'Defined variable to the Input Worksheet
Dim InputSH As Excel.Worksheet
InputSH = InputWKB.Sheets("Create_Attendance_Sheet")
'==========================

'Find the last row
Dim DataRow As Integer
DataRow = InputSH.Range("A2").End(XlDirection.xlDown).Row
'Stored Year into variable
Dim YearNumb As Integer
YearNumb = InputSH.Range("D4").Value
'================================
'Created new application for attendance workbook
Dim OutPutXLApp As Excel.Application
OutPutXLApp = New Excel.Application
OutPutXLApp.Visible = True
'Mentioned number of sheet in newly created workbook
OutPutXLApp.SheetsInNewWorkbook = 1
'Created new workbook and added to the application
Dim OutputXLWkb As Excel.Workbook
OutputXLWkb = OutPutXLApp.Workbooks.Add
'Defined the required variables before stating the looping process
Dim NewSH As Excel.Worksheet
Dim rng As Excel.Range
Dim MonthNumb As Integer
Dim r As Integer
Dim d As Integer
Dim SheetNumber As Integer
SheetNumber = 1
Dim LastColumn As Integer
Dim LastRow As Integer
'======================================
For MonthNumb = InputSH.Range("E4").Value To InputSH.Range("H4").Value
If SheetNumber = 1 Then
NewSH = OutputXLWkb.ActiveSheet
Else
NewSH = OutputXLWkb.Worksheets.Add(After:=OutputXLWkb.Sheets(OutputXLWkb.Sheets.Count))
End If
NewSH.Name = MonthName(MonthNumb) & " " & YearNumb
'MsgBox (Day(DateSerial(YearNumb, MonthNumb + 1, 0)))
For d = 1 To Day(DateSerial(YearNumb, MonthNumb + 1, 0))
NewSH.Cells(1, d + 1).Value = DateSerial(YearNumb, MonthNumb, d)
NewSH.Cells(2, d + 1).Value = WeekdayName(Weekday(DateSerial(YearNumb, MonthNumb, d)))
Next
'=====Days and Dates added=====
NewSH.Cells(1, 1).Value = "Date"
NewSH.Cells(2, 1).Value = "Day"
InputSH.Range("A2:A" & DataRow).Copy()
NewSH.Range("A3").PasteSpecial(Excel.XlPasteType.xlPasteValues, False, False)
InputXLApp.CutCopyMode = XlCutCopyMode.xlCopy
LastColumn = NewSH.Range("A1").End(XlDirection.xlToRight).Column
LastRow = NewSH.Range("A1").End(XlDirection.xlDown).Row
NewSH.Cells(1, LastColumn + 1).Value = "Total Present"
NewSH.Cells(1, LastColumn + 2).Value = "Total Absent"
For r = 1 To LastRow
For C = 1 To LastColumn
NewSH.Cells(r, C).Activate
With NewSH.Cells(r, C)
If r >= 3 And C >= 2 Then
' P will display to those cells other than saturday and sunday
If NewSH.Cells(2, C).Value <> "Sunday" And NewSH.Cells(2, C).Value <> "Saturday" Then
.Value = "P"
End If
NewSH.Cells(r, C).Validation.Add(XlDVType.xlValidateList, Formula1:="P,A")
'Excel.Validation.Add(XlDVType.xlValidateList, Formula1:="P,A")
.Validation.IgnoreBlank = True
.Validation.InCellDropdown = True
End If
.Font.Size = 15
.Font.Name = "Century"
If r > 2 And C = 1 Then
.HorizontalAlignment = Excel.Constants.xlLeft
Else
.HorizontalAlignment = Excel.Constants.xlCenter
End If
If r = 1 Then
.Interior.ColorIndex = 9
.Font.ColorIndex = 2
.Font.Bold = True
ElseIf r = 2 Then
.Interior.ColorIndex = 56
.Font.ColorIndex = 6
.Font.Bold = True
ElseIf r > 2 And NewSH.Cells(2, C).Value = "Sunday" _
Or NewSH.Cells(2, C).Value = "Saturday" Then
.Interior.ColorIndex = 15
Else
.Interior.ColorIndex = 20
.Font.ColorIndex = 1
End If
End With
Next 'Column Loop
If r >= 3 Then
rng = NewSH.UsedRange
'MsgBox ("=COUNTIF(B" & r & ":" & rng.Cells(r, Lastcolumn).Address(False, False) & ", ""P"")")
NewSH.Cells(r, LastColumn + 1).Formula = "=COUNTIF(B" & r & ":" & rng.Cells(r, LastColumn).Address(False, False) & ", ""P"")"
NewSH.Cells(r, LastColumn + 2).Formula = "=COUNTIF(B" & r & ":" & rng.Cells(r, LastColumn).Address(False, False) & ", ""A"")"
With NewSH.Range(rng.Cells(r, LastColumn + 1), rng.Cells(r, LastColumn + 2))
.Interior.ColorIndex = 10
.Font.ColorIndex = 2
.Font.Size = 15
.Font.Name = "Century"
.HorizontalAlignment = Excel.Constants.xlCenter
End With
End If
Next ' Rows Loop
rng = NewSH.UsedRange
With NewSH.Range(rng.Cells(1, LastColumn + 1), rng.Cells(2, LastColumn + 2))
.Interior.ColorIndex = 10
.Font.ColorIndex = 2
.Font.Size = 15
.Font.Name = "Century"
.HorizontalAlignment = Excel.Constants.xlCenter
End With
NewSH.UsedRange.Columns.AutoFit()
SheetNumber = SheetNumber + 1
Next ' Months Loop
OutPutXLApp.SheetsInNewWorkbook = 3
InputXLApp.Quit()
InputXLApp = Nothing
InputWKB = Nothing
InputSH = Nothing
MsgBox("Hi Pavan completed")
End Sub
End Class