1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99
| Sub genReport()
Dim reportName As String
Dim reportSheetName As String
Dim shName As String
Dim Msg As String
Dim wString As String
Dim wshName As Worksheet
Dim emplName As Variant
Dim myPlageSearch As Variant
Dim wWbk As Workbook
Dim resCall As Boolean
Dim oldEmployees As Range
Dim tempPlage As Range
Dim intLine As Integer
Dim indexline As Integer
Dim iLine As Integer
Dim intCol As Integer
Dim iPlageLastLine As Integer
Dim returnsearchOld As Double
'get the workbookName
'check the sheet for the report exist; else create it
If ActiveWorkbook.name = testWorkbookName Then
'resCall = FeuilleExiste(shReportTest)
If FeuilleExiste(shReportTest) = False Then
'create the sheet
Sheets.Add After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Select
Sheets(Sheets.Count).name = shReportTest
End If
Sheets(shReportTest).Select
Set wshName = Sheets(shReportTest)
' test if the sheet with Time booking exists, then copy it to the new created sheet
Call copy2consoSheet(wshName, "testSheet")
'this table may contain the resources in the exception list
'do a loop on this list to delete lie with the resources Names concerned.
Set oldEmployees = Range("Former_Employees")
intLine = oldEmployees.Rows.Count
indexline = 1
intCol = oldEmployees.Columns.Count
'Prepare teh tables for the search & delete line with old employees
intCol = calcColFin(wshName)
Set myPlageSearch = Range(Cells(numLine(resCTSCECCol, wshName), NumCol(resCTSCECCol, wshName)), Cells(calcLnFin(wshName), intCol))
iPlageLastLine = myPlageSearch.Rows.Count
intCol = myPlageSearch.Columns.Count
'For Each emplName In Range("Former_Employees").Columns(2).Cells
intLine = 1
For Each emplName In oldEmployees.Columns(2).Cells
Debug.Print emplName.Value
' do a lookup on the value to delete the line having this name is the column of CEC ID
On Error Resume Next
If IsError(returnsearchOld = WorksheetFunction.VLookup(emplName, myPlageSearch, 1, False)) Then
Debug.Print "Former Employee: " & emplName.Value & "already deleted from the employees list" & Chr(13)
'MsgBox "Error On VLookup"
'Err.Clear
'If Err.Number <> 0 Then
' Msg = "L'erreur # " & Str(Err.Number) & " a été générée par " _
' & Err.Source & Chr(13) & Err.Description
' MsgBox Msg, , "Erreur", Err.HelpFile, Err.HelpContext
'End If
'Exit Sub
Else
Debug.Print " Find old Employee: " & emplName.Value
'try to delete the entire line
intLine = Application.Match(emplName, myPlageSearch, 0)
iLine = myPlageSearch.Cells.Find(emplName.Value).Row 'store num line where name is found
' delete this line
'wshName.Rows(iLine).EntireRow.Delete
' update the number of lines
'iPlageLastLine = iPlageLastLine - 1
End If
Next
'build the Pivot Table
Set oldEmployees = Nothing
Set myPlageSearch = Nothing
Set wshName = Nothing
End If 'on workbook TestName
End Sub ' fin de la routine proicipale |
Partager