Kezdőlap › Fórumok › Excel programozás › excel makró munkakezdés › Hozzászólás: excel makró munkakezdés
Private Sub Worksheet_Change(ByVal Target As Range)
Dim kezdes As String
Dim vege As String
Dim perce As Integer
kezdes = Cells(Target.Row, 3).Value
vege = Cells(Target.Row, 4).Value
If Target.Column = 4 Then
perce = CInt(Minute(CDate(vege)))
Select Case perce
Case 0, 30
Cells(Target.Row, 5).Value = ((vege – kezdes) * 24)
Case 1 To 59
Cells(Target.Row, 5).Value = WorksheetFunction.RoundUp((vege – kezdes) * 24 / 0.5, 0) * 0.5
End Select
End If
End Sub
Private Sub Workbook_NewSheet(ByVal Sh As Object)
Dim nev%
Dim hveg
Dim ev, ho, nap As Integer
If Sh.Name Like „Mu*” Then
nev% = InputBox(„Kérem az aktuális hónapot számmal”, „Hónap”)
honev = honap(nev%)
If Sh.Name <> „” Then
Sh.Name = honev
End If
End If
‘hveg = InputBox(„Kérem az aktuális dátumot elsejétől ‘pl igy 2013.06.01′”, „Hónaputolsó”)
nap = 1
hveg = DateSerial(2015, 12, 1)
utolso = hovege(hveg)
‘ev = Year(Date)
‘ho = Month(Date)
Range(„A1”) = „Dátum”
Range(„B1”) = „Napok”
Range(„C1”) = „Kezdés”
Range(„D1”) = „Vége”
Range(„E1”) = „Ledolgozott Idő”
With Range(„A1:E1”) ‘ A fejléc cellái
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Font.Name = „Calibri”
.Font.Size = 16
.Font.Bold = True
.Columns.AutoFit
.Borders(xlEdgeBottom).LineStyle = xlDouble
End With
Range(„A2:E” & utolso + 1).Select
With Selection
.Font.Size = 16
.Font.Name = „Calibri”
.Font.Bold = True
End With
Range(„B2:B” & utolso + 1).Select
With Selection
.Font.Size = 16
.Font.Name = „Calibri”
.Font.Bold = True
.Columns.AutoFit
End With
Range(„A2:B” & utolso + 1).HorizontalAlignment = xlCenter
Columns(„A:A”).ColumnWidth = 15
Columns(„B:B”).ColumnWidth = 14
Columns(„C:C”).ColumnWidth = 12
Columns(„D:D”).ColumnWidth = 11
Columns(„E:E”).ColumnWidth = 15
Range(„A1:E1”).Interior.ColorIndex = 15
Range(„A2:A” & utolso + 1).Interior.ColorIndex = 43
Range(„B2:B” & utolso + 1).Interior.ColorIndex = 6
Range(„C2:C” & utolso + 1).Interior.ColorIndex = 40
Range(„D2:D” & utolso + 1).Interior.ColorIndex = 32
Range(„E2:E” & utolso + 1).Interior.ColorIndex = 7
Range(„A2:A” & utolso + 1).Font.ColorIndex = 49
Range(„B2:B” & utolso + 1).Font.ColorIndex = 53
Range(„C2:C” & utolso + 1).Font.ColorIndex = 14
Range(„D2:D” & utolso + 1).Font.ColorIndex = 3
Range(„E2:E” & utolso + 1).Font.ColorIndex = 49 ’18
With Selection.Font
.Size = 15
.Name = „Calibri”
.Bold = True
End With
With Range(„A2”) ‘ Az aktuális dátum 1-30 vagy 31.-e között
.FormulaR1C1 = CVDate(hveg)
.AutoFill Destination:=Range(„A2:A” & utolso + 1), Type:=xlFillDefault
.Columns.AutoFit
End With
With Range(„B2”) ‘ Az aktuális dátum napjai
.FormulaR1C1 = „=TEXT(RC[-1],””nnnn””)”
.AutoFill Destination:=Range(„B2:B” & utolso + 1)
.ColumnWidth = 15
End With
End Sub
Public Function honap(hnev As Integer)
Dim N
N = MonthName(hnev, False)
honap = N
End Function
Public Function hovege(hdatum As Date)
Dim NN
NN = WorksheetFunction.EoMonth(hdatum, 0)
hovege = Day(NN)
End Function