Verilen iki kodu da butonla kullanmak istiyorum

Akif59

Altın Üye
Katılım
15 Mart 2020
Mesajlar
66
Excel Vers. ve Dili
2013 ve 2016
Altın Üyelik Bitiş Tarihi
20-03-2025
Merhaba
verilen kodları butonla kullanılacak şekilde revize edebilmek için yardımlarınızı rica ediyorum

Kod:
[CODE]Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
ActiveSheet.Unprotect "1007"
Application.ScreenUpdating = False
If Target.Address(0, 0) = "D20" Then
    ilkDeger = Left(Target.Offset(1, -1), Len(Target.Offset(1, -1)) - 1)
    Cancel = True
    For i = 22 To 119
        If ActiveSheet.Rows(i).EntireRow.Hidden Then
            ActiveSheet.Rows(i).EntireRow.Hidden = False
            ActiveSheet.Cells(i, 3) = ilkDeger & (i - 20)
            Exit For
        End If
    Next
End If

If Target.Address(0, 0) = "E20" Then
    Cancel = True
   For i = 114 To 21 Step -1
    If Not ActiveSheet.Rows(i).EntireRow.Hidden Then
        ActiveSheet.Rows(i).EntireRow.Hidden = True
        ActiveSheet.Range("A" & i & ":DJ" & i).ClearContents
        ActiveSheet.Range("DM" & i & ":DO" & i).ClearContents
       Exit For
    End If
  Next
End If

Application.ScreenUpdating = True
ActiveSheet.Protect "1007"
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
ActiveSheet.Unprotect "1007"
Application.EnableEvents = False

If Target.Address(0, 0) = "D20" Then
    Cancel = True
    ilkDeger = Left(Target.Offset(1, -1), Len(Target.Offset(1, -1)) - 1)
    For i = 22 To 119
        ActiveSheet.Rows(i).EntireRow.Hidden = False
        ActiveSheet.Cells(i, 3) = ilkDeger & (i - 20)
    Next
End If
If Target.Address(0, 0) = "E20" Then
    Cancel = True
     ActiveSheet.Range("22:119").EntireRow.Hidden = True
     ActiveSheet.Range("A22:DJ119").ClearContents
     ActiveSheet.Range("DM22:DO119").ClearContents
End If

Application.EnableEvents = True
end sub
 
Üst