Telefonszámunk: 1-472-0679

Hozzászólás: excel makró munkakezdés

Kezdőlap Fórumok Excel programozás excel makró munkakezdés Hozzászólás: excel makró munkakezdés

#2417
Imre
Felhasználó

    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