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
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