Delila10 Creative Commons License 2012.02.21 0 0 17267

Még mindig nem jó. A változások csak akkor következhetnek be a duplaklikkre, ha az A oszlopban még nincs pipa.

 

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    ActiveSheet.Protect Password:="jelszo", UserInterfaceOnly:=True
    Application.EnableEvents = False
    Dim rng As Range
    
    If Range(Target.Row, 1) <> "ü" Then
        If Not Intersect(Target, Me.Range("F28:F2530")) Is Nothing Then
            Set rng = Range(Intersect(Me.Rows(16), Target.EntireColumn), Target.Offset(-1))
            If rng Is Nothing Then Exit Sub
            Target.Value = Application.WorksheetFunction.Max(rng) + 1
        End If
         
        If Target.Column = 1 Then
            Range(Target.Address) = "ü"
            With Selection.Font
                .Name = "Wingdings"
                .Bold = True
                .ColorIndex = 3
            End With
            Range("A" & Target.Row & ":V" & Target.Row).Select
            With Selection
                .Font.ColorIndex = 3
                .Locked = True
            End With
        End If
         
        If Target.Column = 3 Or Target.Column = 4 _
            Or Target.Column = 12 Then Range(Target.Address) = Date
         
        If Target.Column = 18 Then Range(Target.Address) = "IGEN"
    End If
    
    Cancel = True
    Application.EnableEvents = True
End Sub

 

Remélem, így már jó lesz.

 

Előzmény: Redlac (17262)