Facebook
From Paltry Zebra, 1 Year ago, written in Plain Text.
Embed
Download Paste or View Raw
Hits: 124
  1. Sub Start()
  2.     Sheet1.Range("B1").NumberFormat = "dd.mm.yyyy"
  3.     Sheet1.Range("B1") = Date
  4.     Sheet1.Range("C1").NumberFormat = "h:mm:ss"
  5.     Sheet1.Range("C1") = Time
  6. End Sub
  7.  
  8. Sub Stopp()
  9.     Sheet1.Range("B2").NumberFormat = "dd.mm.yyyy"
  10.     Sheet1.Range("B2") = Date
  11.     Sheet1.Range("C2").NumberFormat = "h:mm:ss"
  12.     Sheet1.Range("C2") = Time
  13.    
  14.     Sheet1.Range("C3").NumberFormat = "h:mm:ss"
  15.     Sheet1.Range("C3") = Range("C2") - Range("C1")
  16.    
  17.     Worksheets("Michal_Kluba").Activate
  18.     Sheet3.Columns("A").NumberFormat = "dd.mm.yyyy"
  19.     Sheet3.Columns("B").NumberFormat = "h:mm:ss"
  20.    
  21.     Sheet3.Range("A3").Select
  22.     Do While ActiveCell.Value <> ""
  23.     ActiveCell.Offset(1, 0).Select
  24.     Loop
  25.     ActiveCell.Value = Sheet1.Range("B1")
  26.    
  27.     Sheet3.Range("B3").Select
  28.     Do While ActiveCell.Value <> ""
  29.     ActiveCell.Offset(1, 0).Select
  30.     Loop
  31.     ActiveCell.Value = Sheet1.Range("C3")
  32. End Sub
  33.  
  34. Sub Send()
  35.     Dim OutApp As Object
  36.     Dim OutMail As Object
  37.     Set OutApp = CreateObject("Outlook.Application")
  38.     Set OutMail = OutApp.CreateItem(0)
  39.     With OutMail
  40.         .To = "dominika.ostrowska@capgemini.com"
  41.         .Subject = "TIMERECORDER Michal Kluba " & Range("B1")
  42.         .Body = "Start time: " & Range("C1").Text & vbNewLine & "End time: " & Range("C2").Text & vbNewLine & "Total hours: " & Range("C3").Text
  43.         .Send
  44.     End With
  45.     Set OutMail = Nothing
  46.     Set OutApp = Nothing
  47. End Sub
  48.  
  49. Sub Send2()
  50.     Dim BiezacySkoroszyt As String
  51.     Dim BiezacyArkusz As String
  52.     Dim NowySkoroszyt As String
  53.  
  54.     BiezacySkoroszyt = ActiveWorkbook.Name
  55.     NowySkoroszyt = "Michal_Kluba" & ".xls"
  56.        
  57.     Set nowy = Workbooks.Add
  58.     Windows(BiezacySkoroszyt).Activate
  59.     nowy.SaveAs Filename:=NowySkoroszyt
  60.     ActiveWorkbook.Sheets("Michal_Kluba").Activate
  61.     ActiveSheet.Copy Before:=Workbooks(NowySkoroszyt).Sheets(1)
  62.     nowy.Save
  63.     ActiveWorkbook.SendMail Recipients:="michal.kluba@capgemini.com", Subject:="Michal Kluba MONTHLY REPORT"
  64.     nowy.Close
  65.  
  66.     Application.ScreenUpdating = True
  67.     Windows(BiezacySkoroszyt).Activate
  68. End Sub
  69.