Makro ile sayfaya sığdırma

Katılım
15 Ekim 2014
Mesajlar
833
Excel Vers. ve Dili
Excell 2016 Türkçe 64 bit
Altın Üyelik Bitiş Tarihi
18/10/2022
Merhaba arkadaşlar. Ekli dosyada detaylı olarak açıkladığım şekilde dolu satırların satır yüksekliğini sayfaya sığdıracak, G7 ile AK23 arasındaki satırlara sadece 1 ve üstü rakamların girişine izin verilecek ve AL7 ile AL23 arasındaki her satır toplamının 50 saati geçmeyecek makroya ihtiyacım var. Yardım eder misiniz?
 

Ekli dosyalar

AdemCan

Altın Üye
Destek Ekibi
Katılım
1 Eylül 2008
Mesajlar
1,386
Excel Vers. ve Dili
2019 TR
Merhaba konu üzerinden zaman geçmiş ancak 1 ve 2 numaralı istediğiniz için Mesai Cetveli sayfasının kod penceresine şu kodları ekleyiniz.
3 numaralı istediğiniz mevcut dosyanız üzerinde olmaktadır.
Kod:
Public onceki

Private Sub Worksheet_Activate()
Unprotect Password:="7895123"
son = WorksheetFunction.Max([A:A]) + 6
If son > 6 Then
    Application.ScreenUpdating = False
    Rows("7:23").Hidden = False
    Rows(son + 1 & ":23").Hidden = True
    Application.ScreenUpdating = True
End If
Protect Password:="7895123"
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

    If (Target.Column >= 7 And Target.Column <= 37) And _
        (Target.Row >= 7 And Target.Row <= 23) Then
        
        If Target.Value = 0 Or Not IsNumeric(Target.Value) Then
            Application.EnableEvents = False
                Target.ClearContents
            Application.EnableEvents = True
            Exit Sub
        End If
        
        toplam = WorksheetFunction.Sum(Range("G" & Target.Row & ":AK" & Target.Row))
        If toplam > 50 Then
            Target.Value = onceki
        End If
    End If

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If (Target.Column >= 7 And Target.Column <= 37) And _
            (Target.Row >= 7 And Target.Row <= 23) Then
        onceki = Target.Value
    End If
End Sub
 
Katılım
15 Ekim 2014
Mesajlar
833
Excel Vers. ve Dili
Excell 2016 Türkçe 64 bit
Altın Üyelik Bitiş Tarihi
18/10/2022
Teşekkür ederim sayın AdemCan elinize sağlık
 

AdemCan

Altın Üye
Destek Ekibi
Katılım
1 Eylül 2008
Mesajlar
1,386
Excel Vers. ve Dili
2019 TR
Rica ederim.
 
Üst