Keresés

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.

Ha kiegészíthetem két sorral:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    ActiveSheet.Protect Password:="jelszo", UserInterfaceOnly:=True

    On Error Goto Hiba_esetén
    Application.EnableEvents = False
    
    Dim rng As Range
    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
        ActiveCell = "ü"
        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"
    
    Cancel = True

Hiba_esetén:
    Application.EnableEvents = True
End Sub

Egy kicsit gatyába rázva a makró:

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 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
        ActiveCell = "ü"
        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"
    
    Cancel = True
    Application.EnableEvents = True
End Sub

Az End Sub fölé tedd be ezt a sort:

Application.EnableEvents = True

Van egy másik hiba is. A pipa jel formázási része ilyen legyen:

With Selection.Font

.Name = "Wingdings"

.Bold = True 

.ColorIndex = 3 

End With

az általad írt

With Selection.Font.Name = "Wingdings"

.Bold = True

.ColorIndex = 3

End With

helyett.

Az lemaradt, hogy a dupla klikkre simán belép a cellába.

Ez meg mostan mé' nem megyen? :-(

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

ActiveSheet.Protect Password:="jelszó", UserInterfaceOnly:=True

Dim rng As Range

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

Application.EnableEvents = False

Target.Value = Application.WorksheetFunction.Max(rng) + 1

Cancel = True

Application.EnableEvents = True

End If

If Target.Column = 1 Then

ActiveCell = "ü"

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 Then Range(Target.Address) = Date

Cancel = True

If Target.Column = 4 Then Range(Target.Address) = Date

Cancel = True

If Target.Column = 12 Then Range(Target.Address) = Date

Cancel = True

If Target.Column = 18 Then Range(Target.Address) = "IGEN"

Cancel = True

ActiveSheet.Protect Pass

End Sub

Pedig egy darabig olyan jól muzsikáltak együtt, aztán valamit elradiroztam...

Szívesen.

Köszönöm!

Védett lapról van szó, mert az egyes cellák zárolása csak így érvényesül.

Az "ActiveSheet.Protect UserInterfaceOnly:=True" sor makróból engedélyezi a módosítást.

Ha jelszóval véded a lapot, ezt írd helyette:

ActiveSheet.Protect Password:="Hű_de_titkos_jelszó", UserInterfaceOnly:=True

Az a módszer is jó, amit Te írtál.

Védett lapról van szó, mert az egyes cellák zárolása csak így érvényesül.

Az "ActiveSheet.Protect UserInterfaceOnly:=True" sor makróból engedélyezi a módosítást.

Ha jelszóval véded a lapot, ezt írd helyette:

ActiveSheet.Protect Password:="Hű_de_titkos_jelszó", UserInterfaceOnly:=True

Az a módszer is jó, amit Te írtál.

Köszönöm, remekül működik.

Még a végére beleraktam egyéb dupla kattintást, de a vegyülés is jól megy :-)

Ez a sor mit jelent?

"ActiveSheet.Protect UserInterfaceOnly:=True"

Ha jelszót teszek a lapra, akkor ennek a helyére kellene beírni, hogy:

Pass = "jelszó"   

ActiveSheet.Unprotect Pass

Illetve a végére:

ActiveSheet.Protect Pass

Müxik?

:)

Ja, ha nem végzem el a másolást, akkor hibaüzenet fogad. Mostmár értem.

Köszi Delila! :)

Nincs ezzel semmi baj, csak előtte a másolandó területet ki kell jelölni, és másolni, majd az új helyre állva kell indítani a makrót – akár bill. kombinációval. Én is sűrűn alkalmazom, de a végére még betettem a kijelölés megszüntetését.

Sub Érték_beillesztése()

     'Billentyűparancs: Ctrl+e 

     Selection.PasteSpecial Paste:=xlValues 

     Application.CutCopyMode = False

End Sub

Hát például az, hogy hiányzik belőle a select és a copy parancs.

Sziasztok!

Szeretnék egy érték beillesztés makrót, hogy majd a hozzárendelt billentyűkombinációval működjön az érték beillesztés, de hibaüzenetet kapok a futtatáskor. Mi a baj ezzel a makróval?

Sub PasteValue()
'
' PasteValue Makró
'
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End Sub

Köszi!

Így lehet kombinálni:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    ActiveSheet.Protect UserInterfaceOnly:=True
    
    If Target.Column = 1 Then
        ActiveCell = "ü"
        With Selection.Font
            .Name = "Wingdings"
            .Bold = True
            .ColorIndex = 3
        End With
        Range("A" & Target.Row & ":U" & Target.Row).Select
        With Selection
            .Font.ColorIndex = 3
            .Locked = True
        End With
    End If
    
    If Target.Column = 3 Then Range(Target.Address) = Date
End Sub

Ha az A oszlopban (If Target.Column = 1) klikkelsz duplán, akkor beírja a pipát, és zárolja a sor celláit az A:U oszlopokban.

Ha viszont a C oszlopban kattintasz duplán, akkor a klikkelés helyére beírja a mai dátumot.

Ez egyébként remek is lenne, de van jó pár helyen, ahol a dupla klikk a dátumot, vagy egyebet visz be (igen, nem).

Ha ezzel bárhol kattintok duplán ott meglesz a pipa (ez a wingdinges megoldás szuper :-)), de ott is, ahol eddig a dátumnak ellene lennie.

Csak az "A oszlopra tudod fókuszálni ezt a dupla klikket, mert a meglévőkkel próbáltam kombinálni, de nem működött.

Köszi előre is :-)

Talán egyszerűbb lenne letölteni egy ingyenes pdf nyomtató drivert, ettől kezdve a pdf nyomtatás külön nyomtatóként kiválasztható. Én ezt használom, ha máshova kell átvinni fájlokat, nem kell beállítani nyomtatási képet az aktuális nyomtatóhoz.

Mit szólsz ehhez a megoldáshoz? Megszünteted a jelölőnégyzeteket. Egy-egy cellán duplaklikkre piros pipa jel jelenik meg, az aktuális sor A:U tartománya zárolt lesz, a karakterek szintén piros színben pompáznak?

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    ActiveSheet.Protect UserInterfaceOnly:=True
    ActiveCell = "ü"
    With Selection.Font
        .Name = "Wingdings"
        .Bold = True
        .ColorIndex = 3
    End With
    Range("A" & Target.Row & ":U" & Target.Row).Select
    Selection.Font.ColorIndex = 3
    Selection.Locked = True
End Sub

Ezt a makrót is a laphoz kell rendelni.

Egy csoporton belül a szerveren elhelyezett táblázatot (egyfajta iktatót) soronként töltünk ki.

Amikor a tényleges iktatás megtörténik, és minden rendben van a beírt adatokkal, akkor a csoportvezető pipálná, hogy rendben (ez egyben át is szinezné az adott sort, hogy feltűnőbb legyen), és onnan kezdve nem lehetne módosítani az adott sort. Tehát a pipálásnak kell az utolsónak lenni.

Próbáld meg úgy átrendezni az oszlopaidat, hogy először kelljen a négyzetet jelölni, és utoljára adatot bevinni a billentyűzetről. Ehhez az utolsó oszlophoz igazítsd a makrót.

A jelölőnégyzetek hivatkozása zárná le, ami ebben az esetben mondjuk a B oszlop cellája.

Az A-ba raktam a jelölőnégyzetet, ahol még egy sorszám van csak. A B-re hivatkozik, de azt elrejtem. A lezárandó pedig a A-U lenne.

Azt gondoltam, hogy a lezárásnak mindegy hogyan lesz "tele" a cella.

Ez egy eseménykezelő makró, ami a billentyűzetről bevitt eseményt figyeli.

Át lehetne írni pl. duplaklikk figyelésére, de akkor nem hajtódna végre a G oszlopba történő beírás után, pedig a leírásod szerint ez a fontos. 

Szia Delila!

Arra nincs valami ötleted, hogy miért nem zárja le, ha nem manuálisan írom be, hanem képletből érkezik az utolsó beírás?

Jimmy! Nézz be a postaládádba!

Vagy ha pl.: LibreOffice-t használsz, nem kell semmilyen kódsor, nyomtathatsz azonnal PDF formátumba....-)) (bocsánat az offtopikért:-))

Egyébként 2010-esben lehet pdf-ként menteni.