Untitled
unknown
plain_text
3 years ago
12 kB
5
Indexable
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Selection.Count = 1 Then
Dim Name As Range
Dim LearningLane As Range
Dim eNumber As Range
Dim Team As Range
Dim ActualPos As Range
Dim WorkStarted As Range
Dim PathType As Range
Dim ActualLane As Range
Dim NewPos As Range
Dim Trainer As Range
Dim PathStarted As Range
Dim Status As Range
Dim Desc As Range
If Selection.Column = 14 Then
If Sheets("SZKOLENIA").Cells(Target.Row, 12).Value = "Gotowy do egzaminu" And Sheets("SZKOLENIA").Cells(Target.Row, 1).Value <> 0 And Sheets("SZKOLENIA").Cells(Target.Row, 6).Value <> 0 And Sheets("SZKOLENIA").Cells(Target.Row, 12).Value <> 0 Then
If Target.Row > 2 Then
Set Name = Sheets("SZKOLENIA").Cells(Selection.Row, 1)
Set LearningLane = Sheets("SZKOLENIA").Cells(Selection.Row, 9)
Set eNumber = Sheets("SZKOLENIA").Cells(Selection.Row, 2)
Set Team = Sheets("SZKOLENIA").Cells(Selection.Row, 3)
Set ActualPos = Sheets("SZKOLENIA").Cells(Selection.Row, 4)
Set WorkStarted = Sheets("SZKOLENIA").Cells(Selection.Row, 5)
Set PathType = Sheets("SZKOLENIA").Cells(Selection.Row, 6)
Set ActualLane = Sheets("SZKOLENIA").Cells(Selection.Row, 7)
Set NewPos = Sheets("SZKOLENIA").Cells(Selection.Row, 8)
Set Trainer = Sheets("SZKOLENIA").Cells(Selection.Row, 10)
Set PathStarted = Sheets("SZKOLENIA").Cells(Selection.Row, 11)
Set Status = Sheets("SZKOLENIA").Cells(Selection.Row, 12)
Set Desc = Sheets("SZKOLENIA").Cells(Selection.Row, 13)
Sheets("SZKOLENIA").Cells(Selection.Row, 14).Interior.ColorIndex = 15
Sheets("SZKOLENIA").Cells(Selection.Row, 14).Value = "WYSüANO"
Sheets("SZKOLENIA").Cells(Selection.Row, 14).Font.Bold = False
CreateMailLeader Name, LearningLane, eNumber, Team, ActualPos, WorkStarted, PathType, ActualLane, NewPos, Trainer, PathStarted, Status, Desc
End If
End If
End If
If Selection.Column = 24 Then
If Sheets("SZKOLENIA").Cells(Target.Row, 17).Value <> 0 And Sheets("SZKOLENIA").Cells(Target.Row, 18).Value <> 0 And Sheets("SZKOLENIA").Cells(Target.Row, 19).Value <> 0 Then
If Target.Row > 2 Then
Set Name = Sheets("SZKOLENIA").Cells(Selection.Row, 1)
Set LearningLane = Sheets("SZKOLENIA").Cells(Selection.Row, 9)
Set eNumber = Sheets("SZKOLENIA").Cells(Selection.Row, 2)
Set Team = Sheets("SZKOLENIA").Cells(Selection.Row, 3)
Set ActualPos = Sheets("SZKOLENIA").Cells(Selection.Row, 4)
Set WorkStarted = Sheets("SZKOLENIA").Cells(Selection.Row, 5)
Set PathType = Sheets("SZKOLENIA").Cells(Selection.Row, 6)
Set ActualLane = Sheets("SZKOLENIA").Cells(Selection.Row, 7)
Set NewPos = Sheets("SZKOLENIA").Cells(Selection.Row, 8)
Set Trainer = Sheets("SZKOLENIA").Cells(Selection.Row, 10)
Set PathStarted = Sheets("SZKOLENIA").Cells(Selection.Row, 11)
Set Status = Sheets("SZKOLENIA").Cells(Selection.Row, 12)
Set Desc = Sheets("SZKOLENIA").Cells(Selection.Row, 13)
Dim PathEnded As Range
Dim StatusPE As Range
Dim Points As Range
Dim MaxPoints As Range
Dim Percents As Range
Dim PercentsPE As Range
Dim DescPE As Range
Dim Examiner As Range
Set PathEnded = Sheets("SZKOLENIA").Cells(Selection.Row, 16)
Set StatusPE = Sheets("SZKOLENIA").Cells(Selection.Row, 17)
Set Points = Sheets("SZKOLENIA").Cells(Selection.Row, 18)
Set MaxPoints = Sheets("SZKOLENIA").Cells(Selection.Row, 19)
Set Percents = Sheets("SZKOLENIA").Cells(Selection.Row, 20)
Set PercentsPE = Sheets("SZKOLENIA").Cells(Selection.Row, 21)
Set Examiner = Sheets("SZKOLENIA").Cells(Selection.Row, 22)
Set DescPE = Sheets("SZKOLENIA").Cells(Selection.Row, 23)
Sheets("SZKOLENIA").Cells(Selection.Row, 24).Interior.ColorIndex = 15
Sheets("SZKOLENIA").Cells(Selection.Row, 24).Value = "WYSüANO"
Sheets("SZKOLENIA").Cells(Selection.Row, 24).Font.Bold = False
CreateMailPE Name, LearningLane, eNumber, Team, ActualPos, WorkStarted, PathType, ActualLane, NewPos, Trainer, PathStarted, Status, Desc, PathEnded, StatusPE, Points, MaxPoints, Percents, PercentsPE, Examiner, DescPE
End If
End If
End If
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Target.Cells.Count > 1 Then Exit Sub
If Target.Column = "1" And Target.Row > 2 Then
If Sheets("SZKOLENIA").Cells(Target.Row, 1).Value <> 0 Then
For i = 2 To 401
If Sheets("LISTA").Cells(i, 9) = Sheets("SZKOLENIA").Cells(Target.Row, 1).Value Then
Sheets("SZKOLENIA").Cells(Target.Row, 2).Value = Sheets("LISTA").Cells(i, 2).Value
Sheets("SZKOLENIA").Cells(Target.Row, 3).Value = "Brygada " & Sheets("LISTA").Cells(i, 8).Value
Sheets("SZKOLENIA").Cells(Target.Row, 4).Value = Sheets("LISTA").Cells(i, 5).Value
Sheets("SZKOLENIA").Cells(Target.Row, 5).Value = Sheets("LISTA").Cells(i, 6).Value
End If
Next i
Else
Sheets("SZKOLENIA").Cells(Target.Row, 2).Value = ""
Sheets("SZKOLENIA").Cells(Target.Row, 3).Value = ""
Sheets("SZKOLENIA").Cells(Target.Row, 4).Value = ""
Sheets("SZKOLENIA").Cells(Target.Row, 5).Value = ""
End If
End If
If (Target.Column = "1" Or Target.Column = "6" Or Target.Column = "12") And Target.Row > 2 Then
If Sheets("SZKOLENIA").Cells(Target.Row, 12).Value = "Gotowy do egzaminu" And Sheets("SZKOLENIA").Cells(Target.Row, 1).Value <> 0 And Sheets("SZKOLENIA").Cells(Target.Row, 6).Value <> 0 And Sheets("SZKOLENIA").Cells(Target.Row, 12).Value <> 0 Then
Cells(Target.Row, 14).Value = "WYĺLIJ"
Cells(Target.Row, 14).Font.Bold = True
Cells(Target.Row, 14).Interior.ColorIndex = 44
Else
Cells(Target.Row, 14).Value = ""
Cells(Target.Row, 14).Font.Bold = False
Cells(Target.Row, 14).Interior.ColorIndex = 0
End If
End If
If (Target.Column = "17" Or Target.Column = "18" Or Target.Column = "21") And Target.Row > 2 Then
If Sheets("SZKOLENIA").Cells(Target.Row, 17).Value <> 0 And Sheets("SZKOLENIA").Cells(Target.Row, 18).Value <> 0 And Sheets("SZKOLENIA").Cells(Target.Row, 21).Value <> 0 Then
Cells(Target.Row, 24).Value = "WYĺLIJ"
Cells(Target.Row, 24).Font.Bold = True
Cells(Target.Row, 24).Interior.ColorIndex = 41
Else
Cells(Target.Row, 24).Value = ""
Cells(Target.Row, 24).Font.Bold = False
Cells(Target.Row, 24).Interior.ColorIndex = 0
End If
End If
End Sub
Sub CreateMailLeader(Name As Range, LearningLane As Range, eNumber As Range, Team As Range, ActualPos As Range, WorkStarted As Range, PathType As Range, ActualLane As Range, NewPos As Range, Trainer As Range, PathStarted As Range, Status As Range, Desc As Range)
Dim objOutlook As Object
Dim objMail As Object
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
With objMail
.To = "IP_CV@velvetcare.pl;artur.urbanowski@velvetcare.com;sebastian.lebek@velvetcare.com"
.Subject = "[ĺCIEűKA KARIERY] " & Name.Value & "; linia: " & LearningLane.Value
.HTMLBody = "<b>Operator: </b> " & Name.Value & "<br>" & "<b>Nr ewidencyjny: </b> " & eNumber.Value & "<br>" & "<b>Brygada: </b> " & Team.Value & "<br>" & "<b>Aktualne stanowisko: </b> " & ActualPos.Value & "<br>" & "<b>Data zatrudnienia: </b> " & WorkStarted.Value & "<br>" & "<b>Rodzaj ścieżki kariery: </b> " & PathType.Value & "<br>" & "<b>Obecna linia: </b> " & ActualLane.Value & "<br>" & "<b>Nowe stanowisko po szkoleniu: </b> " & NewPos.Value & "<br>" & "<b>Linia w szkoleniu: </b> " & LearningLane.Value & "<br>" & "<b>Trener: </b> " & Trainer.Value & "<br>" & "<b>Data rozpocz«cia ścieżki kariery: </b> " & PathStarted.Value & "<br>" & "<b>Status: </b> " & Status.Value & "<br>" & "<b>Dodatkowe informacje: </b> " & Desc.Value & "<br><br><b>Arkusz Excel:</b> <a href=""\\plklfn01\SHARE\Corporate\Engineering\Przetworstwo\PRODUKCJA\PRODUKCJA_W_TOKU\OBSADA CV\PMP_sciezki_kariery.xlsb"">PMP_sciezki_kariery.xlsb</a>"
.Display
End With
Set objOutlook = Nothing
Set objMail = Nothing
Set rngTo = Nothing
Set rngSub = Nothing
Set rngMessage = Nothing
End Sub
Sub CreateMailPE(Name As Range, LearningLane As Range, eNumber As Range, Team As Range, ActualPos As Range, WorkStarted As Range, PathType As Range, ActualLane As Range, NewPos As Range, Trainer As Range, PathStarted As Range, Status As Range, Desc As Range, PathEnded As Range, StatusPE As Range, Points As Range, MaxPoints As Range, Percents As Range, PercentsPE As Range, Examiner As Range, DescPE As Range)
Dim objOutlook As Object
Dim objMail As Object
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
With objMail
.To = "grzegorz.jaworski@velvetcare.com;artur.urbanowski@velvetcare.com;sebastian.lebek@velvetcare.com"
.Subject = "[ĺCIEűKA KARIERY END] " & Name.Value & "; linia: " & LearningLane.Value
.HTMLBody = "<b>--- MISTRZ ZMIANY ---</b><br>" & "<b>Operator: </b> " & Name.Value & "<br>" & "<b>Nr ewidencyjny: </b> " & eNumber.Value & "<br>" & "<b>Brygada: </b> " & Team.Value & "<br>" & "<b>Aktualne stanowisko: </b> " & ActualPos.Value & "<br>" & "<b>Data zatrudnienia: </b> " & WorkStarted.Value & "<br>" & "<b>Rodzaj ścieżki kariery: </b> " & PathType.Value & "<br>" & "<b>Obecna linia: </b> " & ActualLane.Value & "<br>" & "<b>Nowe stanowisko po szkoleniu: </b> " & NewPos.Value & "<br>" & "<b>Linia w szkoleniu: </b> " & LearningLane.Value & "<br>" & "<b>Trener: </b> " & Trainer.Value & "<br>" & "<b>Data rozpoczęcia ścieżki kariery: </b> " & PathStarted.Value & "<br>" & "<b>Status: </b> " & Status.Value & "<br>" & "<b>Dodatkowe informacje: </b> " & Desc.Value & "<br><br><b>--- INŻYNIER PROCESU ---</b><br>" & "<b>Data zakończenia ścieżki kariery (egzamin): </b> " & PathEnded.Value & _
"<br>" & "<b>Status: </b> " & StatusPE.Value & "<br>" & "<b>Wynik z matrycy [pkt.]: </b> " & Points.Value & "<br>" & "<b>Maksymalny wynik z matrycy [pkt.]: </b> " & MaxPoints.Value & "<br>" & "<b>Dokładny wynik z matrycy [%]: </b> " & Percents.Value & "<br>" & "<b>Wynik egzaminu [%]: </b> " & PercentsPE.Value & "<br>" & "<b>Egzaminator: </b> " & Examiner.Value & "<br>" & "<b>Dodatkowe informacje: </b> " & DescPE.Value & "<br><br><b>Arkusz Excel:</b> <a href=""\\plklfn01\SHARE\Corporate\Engineering\Przetworstwo\PRODUKCJA\PRODUKCJA_W_TOKU\OBSADA CV\PMP_sciezki_kariery.xlsb"">PMP_sciezki_kariery.xlsb</a>"
.Display
End With
Set objOutlook = Nothing
Set objMail = Nothing
Set rngTo = Nothing
Set rngSub = Nothing
Set rngMessage = Nothing
End SubEditor is loading...