Untitled

mail@pastecode.io avatar
unknown
plain_text
2 years ago
12 kB
1
Indexable
Never
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 Sub