megoldást keresek erre a problémára
-
GImre70 #2131 Sziasztok. Egy kis segítséget kérnék. Készítettem egy táblázatot, ami a ledolgozott időmet tartalmazza.
Készítettem egy makró - előtte - innen-onnan sőt még erről az oldalról is kértem segítséget a makró megírására. Na most az a problémám, hogy amikor lefut a Sub Workbook_NewSheet( Byval Sh as Object) és utána a Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Az ebben a rutinban megírt esemény egyik változója Type Mismatch üzenettel kiáll:
Be másolom a cls fájlt mivel nem tom, hogy hogy kell beilleszteni.
Itt a fájl:
Dim menyinap
Public kezdese
Public veges
Public perce
Public terulet As Range
Private Sub Workbook_NewSheet(ByVal Sh As Object)
Dim menyinap, honapneve
Dim kerdes As Date
If Sh.Name Like "Mun*" Then
kerdes = InputBox("Melyik hónap ? Ird be a dátumot", "Hónap", Date)
honapneve = honnev(kerdes)
Sh.Name = honapneve
End If
menyinap = hanynap(kerdes)
Range("A1").Select
Selection.Formula = "Dátum"
Range("B1").Select
Selection.Formula = "Napok"
Range("C1").Select
Selection.Formula = "Kezdés"
Range("D1").Select
Selection.Formula = "Vége"
Range("E1").Select
Selection.Formula = "Ledolgozott Idő"
Range("A1:E1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Font.Size = 16
.Font.Bold = True
.Columns.AutoFit
End With
Range("A2:E" & menyinap + 1).Activate
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" & menyinap + 1).Interior.ColorIndex = 43
Range("B2:B" & menyinap + 1).Interior.ColorIndex = 6
Range("C2:C" & menyinap + 1).Interior.ColorIndex = 40
Range("D2:D" & menyinap + 1).Interior.ColorIndex = 32
Range("E2:E" & menyinap + 1).Interior.ColorIndex = 7
Range("A2:A" & menyinap + 1).Font.ColorIndex = 49
Range("B2:B" & menyinap + 1).Font.ColorIndex = 53
Range("C2:C" & menyinap + 1).Font.ColorIndex = 14
Range("D2:D" & menyinap + 1).Font.ColorIndex = 3
Range("E2:E" & menyinap + 1).Font.ColorIndex = 49 '18
With Selection.Font
.Size = 15
.Name = "calibri"
.Bold = True
End With
'Range("C2:E" & menyinap + 1).NumberFormat = h & ":" & mm
Range("A2").Select
With Selection
.FormulaR1C1 = kerdes
.AutoFill Destination:=Range("A2:A" & menyinap+1), Type:=xlFillDefault
.Columns.AutoFit
End With
Range("B2").Select
ActiveCell.FormulaR1C1 = "=TEXT(RC[-1],""nnnn"")"
Range("B2").Select
Selection.AutoFill Destination:=Range("B2:B" & menyinap + 1)
Range("B2:B" & menyinap + 1).HorizontalAlignment = xlCenter
End Sub
Public Function honnev(honapp As Date)
Dim neve
neve = MonthName(Month(honapp))
honnev = neve
End Function
Public Function hanynap(anapok)
Dim napszam
napszam = WorksheetFunction.EoMonth(anapok, 0)
hanynap = Day(napszam)
End Function
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim kezdese, veges As Date
Dim perce As Currency
Dim i
Range("c1").Activate
i = ActiveCell.CurrentRegion.Rows.Count - 1
kezdese = Cells(Target.Row, 3)
veges = Cells(Target.Row, 4)
perce = Minute(vege) Type mishmatch hiba
'Debug.Print "kezdés:" & kezdes, "vége:" & vege
'Debug.Print "vege - kezdes:" & WorksheetFunction.RoundUp((vege - kezdes) * 24, 0)
If Target.Column = 4 Then
Select Case perc
Case 0, 30
Cells(Target.Row, 5) = ((vege - kezdes) * 24)
Case 1 To 29
Cells(Target.Row, 5) = WorksheetFunction.RoundUp((vege - kezdes) * 24 / 0.5, 0) * 0.5
Case 31 To 59
Cells(Target.Row, 5) = WorksheetFunction.RoundUp((vege - kezdes) * 24 / 0.5, 0) * 0.5
End Select
End If
End Sub
Ebben kérném a segítséget. Előre is köszönöm.