• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Sayfa numarasına göre "İçindekiler" güncellemesi

.

İçindekilerde satırı gizledikçe aşağıya doğru sayfa numaraları etkiliyordu. Bir kontrol daha ekledim.

Kod: 
Sub kod()
    Dim DikeySay As Integer, YataySay As Integer, SayfaNo As Integer
    Dim Dikey As VPageBreak, Yatay As HPageBreak

    If ActiveSheet.PageSetup.PrintArea = "" Then
        MsgBox "Yazdırma Alanı Belirlenmemiş", vbCritical
        Exit Sub
    End If

    içindekiler_başlangıç = 123
    içindekiler_bitiş = 251
    içindekier_başlıklar = "D"
    sayfa_no_sütunu = "R"

    sayfalar_başlangıç = 252
    sayfa_başlıklar = "A"


    Rows(içindekiler_başlangıç & ":" & içindekiler_bitiş).EntireRow.Hidden = False
    Range(Cells(123, sayfa_no_sütunu), Cells(içindekiler_bitiş, sayfa_no_sütunu)).ClearContents

    ActiveWindow.View = xlPageBreakPreview

    [COLOR="Indigo"]For i = içindekiler_başlangıç To Cells(içindekiler_bitiş [COLOR="Indigo"]+ 1[/COLOR], içindekier_başlıklar).End(3).Row

        If IsError(Cells(i, içindekier_başlıklar)) Then
            Rows(i).EntireRow.Hidden = True
            GoTo sonraki
        End If

        If Cells(i, içindekier_başlıklar) = 0 Then
            Rows(i).EntireRow.Hidden = True
            GoTo sonraki
        End If

        If Cells(i, içindekier_başlıklar) = "" Then
            Rows(i).EntireRow.Hidden = True
            GoTo sonraki
        End If

sonraki:
    Next i
    i = Empty[/COLOR]


    For i = içindekiler_başlangıç To Cells(içindekiler_bitiş + 1, içindekier_başlıklar).End(3).Row

        If Rows(i).EntireRow.Hidden = False Then

            For a = sayfalar_başlangıç To Cells(Rows.Count, sayfa_başlıklar).End(3).Row
                If Cells(i, içindekier_başlıklar) = Cells(a, sayfa_başlıklar) Then

                    If Rows(a).EntireRow.Hidden = True Then Rows(i).EntireRow.Hidden = True

                    sat = Cells(a, sayfa_başlıklar).Row
                    süt = Cells(a, sayfa_başlıklar).Column

                    If ActiveSheet.PageSetup.Order = xlDownThenOver Then
                        YataySay = ActiveSheet.HPageBreaks.Count + 1
                        DikeySay = 1
                    Else
                        DikeySay = ActiveSheet.VPageBreaks.Count + 1
                        YataySay = 1
                    End If
                    SayfaNo = 1
                    For Each Dikey In ActiveSheet.VPageBreaks
                        If Dikey.Location.Column > süt Then Exit For
                        SayfaNo = SayfaNo + YataySay
                    Next Dikey
                    For Each Yatay In ActiveSheet.HPageBreaks
                        If Yatay.Location.Row > sat Then Exit For
                        SayfaNo = SayfaNo + DikeySay
                    Next Yatay

                    Cells(i, sayfa_no_sütunu) = SayfaNo

                    Exit For

                End If
            Next a


        End If
    Next i
    ActiveWindow.View = xlNormalView
    MsgBox "B i t t i "
End Sub

.
 
Merhaba,


windows 10- excel 2016'da denedim sorunsuz çalıştı fakat

macbook- excel 2011'de çalıştırınca ekteki hatayı aldım. neden olabilir?
5GNYkl.png
 
.

İşletim sistemleri ve uygulama farklı.
2 sisteminde kendine göre ayrı ayarları var.
Macbook kullanmadım daha önce. Verdiğim kodlar windows için..

.
 
Emir Bey günaydın.. Ben sizin yazmış olduğunuz makroya aşağıdaki makroyu eklemek istiyorum fakat hata alıyorum.. Nasıl eklemem gerekir acaba?

Not: öncelik sırasına göre yazdım

Kod: 
Private Sub Worksheet_Calculate()
 
    Application.ScreenUpdating = False
    Application.Calculation = xlManual
 
    Rows("1:10000").EntireRow.Hidden = False
    
    
    If UCase(Replace(Replace([W25], "ı", "I"), "i", "İ")) = "HAYIR" Then
        Rows("2904:4182").EntireRow.Hidden = True
        
    End If
    
    If UCase(Replace(Replace([W6], "ı", "I"), "i", "İ")) = "EVET" Then
        Rows("3045:3115").EntireRow.Hidden = True
        Rows("3258:3328").EntireRow.Hidden = True
    ElseIf UCase(Replace(Replace([W6], "ı", "I"), "i", "İ")) = "HAYIR" Then
        Rows("1989:2129").EntireRow.Hidden = True
        Rows("2975:3044").EntireRow.Hidden = True
        Rows("3187:3257").EntireRow.Hidden = True
        Rows("3400:3470").EntireRow.Hidden = True
        
    End If
    
    
    If UCase(Replace(Replace([W2], "ı", "I"), "i", "İ")) = "KADIN" Then
        Rows("3116:3186").EntireRow.Hidden = True
        Rows("3329:3399").EntireRow.Hidden = True
        Rows("3542:3684").EntireRow.Hidden = True
        Rows("4112:4253").EntireRow.Hidden = True
        Rows("4162:4233").EntireRow.Hidden = True
        Rows("6321:6381").EntireRow.Hidden = True
    ElseIf UCase(Replace(Replace([W2], "ı", "I"), "i", "İ")) = "ERKEK" Then
        Rows("1989:2129").EntireRow.Hidden = True
        Rows("2975:3115").EntireRow.Hidden = True
        Rows("3187:3328").EntireRow.Hidden = True
        Rows("3400:3541").EntireRow.Hidden = True
        Rows("3685:3755").EntireRow.Hidden = True
        Rows("4041:4111").EntireRow.Hidden = True
        Rows("6382:6452").EntireRow.Hidden = True
    End If
 
    If UCase(Replace(Replace([W3], "ı", "I"), "i", "İ")) = "EVET" Then
        Rows("1325:1395").EntireRow.Hidden = True
    ElseIf UCase(Replace(Replace([W3], "ı", "I"), "i", "İ")) = "HAYIR" Then
        Rows("1396:1535").EntireRow.Hidden = True
        
    End If
    
    Rows("1710:1780").EntireRow.Hidden = False
    If UCase(Replace(Replace([W4], "ı", "I"), "i", "İ")) = "HAYIR" Then
        Rows("1710:1780").EntireRow.Hidden = True
        
    End If
    
    
    Rows("6262:6321").EntireRow.Hidden = False
    If UCase(Replace(Replace([W8], "ı", "I"), "i", "İ")) = "EVET" Then
        Rows("6262:6321").EntireRow.Hidden = True
        
    End If
    
    Rows("6322:6382").EntireRow.Hidden = False
    If UCase(Replace(Replace([W9], "ı", "I"), "i", "İ")) = "EVET" Then
        Rows("6322:6382").EntireRow.Hidden = True
        
    End If
    
    Rows("6383:6453").EntireRow.Hidden = False
    If UCase(Replace(Replace([W10], "ı", "I"), "i", "İ")) = "EVET" Then
        Rows("6383:6453").EntireRow.Hidden = True
        
    End If
    
    Rows("6454:6530").EntireRow.Hidden = False
    If UCase(Replace(Replace([W11], "ı", "I"), "i", "İ")) = "EVET" Then
        Rows("6454:6530").EntireRow.Hidden = True
        
    End If
    
    Rows("6531:6591").EntireRow.Hidden = False
    If UCase(Replace(Replace([W12], "ı", "I"), "i", "İ")) = "EVET" Then
        Rows("6531:6591").EntireRow.Hidden = True
        
    End If
    
    Rows("6592:6652").EntireRow.Hidden = False
    If UCase(Replace(Replace([W13], "ı", "I"), "i", "İ")) = "EVET" Then
        Rows("6592:6652").EntireRow.Hidden = True
        
    End If
    
    Rows("6653:6714").EntireRow.Hidden = False
    If UCase(Replace(Replace([W14], "ı", "I"), "i", "İ")) = "EVET" Then
        Rows("6653:6714").EntireRow.Hidden = True
        
    End If
    
    Rows("6715:6775").EntireRow.Hidden = False
    If UCase(Replace(Replace([W15], "ı", "I"), "i", "İ")) = "EVET" Then
        Rows("6715:6775").EntireRow.Hidden = True
        
    End If
    
    Rows("6776:6841").EntireRow.Hidden = False
    If UCase(Replace(Replace([W16], "ı", "I"), "i", "İ")) = "EVET" Then
        Rows("6776:6841").EntireRow.Hidden = True
        
    End If
    
    Rows("6842:6907").EntireRow.Hidden = False
    If UCase(Replace(Replace([W17], "ı", "I"), "i", "İ")) = "EVET" Then
        Rows("6842:6907").EntireRow.Hidden = True
        
    End If
    
    Rows("6908:6973").EntireRow.Hidden = False
    If UCase(Replace(Replace([W18], "ı", "I"), "i", "İ")) = "EVET" Then
        Rows("6908:6973").EntireRow.Hidden = True
        
    End If
    
    Rows("4534:5669").EntireRow.Hidden = False
    If UCase(Replace(Replace([W20], "ı", "I"), "i", "İ")) = "HAYIR" Then
        Rows("4534:5669").EntireRow.Hidden = True
        
    End If
    
    Rows("5670:5803").EntireRow.Hidden = False
    If UCase(Replace(Replace([W21], "ı", "I"), "i", "İ")) = "EVET" Then
        Rows("5670:5803").EntireRow.Hidden = True
        
    End If
    
    Rows("5670:5803").EntireRow.Hidden = False
    Rows("6001:6200").EntireRow.Hidden = False
    If UCase(Replace(Replace([W21], "ı", "I"), "i", "İ")) = "EVET" Then
        Rows("5670:5803").EntireRow.Hidden = True
    ElseIf UCase(Replace(Replace([W21], "ı", "I"), "i", "İ")) = "HAYIR" Then
        Rows("6001:6200").EntireRow.Hidden = True
        
    End If
    
    Rows("5804:6000").EntireRow.Hidden = False
    If UCase(Replace(Replace([W22], "ı", "I"), "i", "İ")) = "EVET" Then
        Rows("5804:6000").EntireRow.Hidden = True
        
    End If
    
    Rows("1536:1579").EntireRow.Hidden = False
    If UCase(Replace(Replace([W23], "ı", "I"), "i", "İ")) = "HAYIR" Then
        Rows("1536:1579").EntireRow.Hidden = True
        
    End If
    
    Rows("4254:4465").EntireRow.Hidden = False
    If UCase(Replace(Replace([W24], "ı", "I"), "i", "İ")) = "HAYIR" Then
        Rows("4254:4465").EntireRow.Hidden = True
        
    End If
    
    
    Rows("2762:2832").EntireRow.Hidden = False
    If UCase(Replace(Replace([W26], "ı", "I"), "i", "İ")) = "HAYIR" Then
        Rows("2762:2832").EntireRow.Hidden = True
        
    End If
    
    If UCase(Replace(Replace([W7], "ı", "I"), "i", "İ")) = "EVET" Then
        Rows("273:2129").EntireRow.Hidden = True
        
    End If

 
    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True
 
End Sub

Kod: 
Sub kod()
    Dim DikeySay As Integer, YataySay As Integer, SayfaNo As Integer
    Dim Dikey As VPageBreak, Yatay As HPageBreak

    If ActiveSheet.PageSetup.PrintArea = "" Then
        MsgBox "Yazdırma Alanı Belirlenmemiş", vbCritical
        Exit Sub
    End If

    içindekiler_başlangıç = 123
    içindekiler_bitiş = 251
    içindekier_başlıklar = "D"
    sayfa_no_sütunu = "R"

    sayfalar_başlangıç = 252
    sayfa_başlıklar = "A"


    Rows(içindekiler_başlangıç & ":" & içindekiler_bitiş).EntireRow.Hidden = False
    Range(Cells(123, sayfa_no_sütunu), Cells(içindekiler_bitiş, sayfa_no_sütunu)).ClearContents

    ActiveWindow.View = xlPageBreakPreview

    For i = içindekiler_başlangıç To Cells(içindekiler_bitiş + 1, içindekier_başlıklar).End(3).Row

        If IsError(Cells(i, içindekier_başlıklar)) Then
            Rows(i).EntireRow.Hidden = True
            GoTo sonraki
        End If

        If Cells(i, içindekier_başlıklar) = 0 Then
            Rows(i).EntireRow.Hidden = True
            GoTo sonraki
        End If

        If Cells(i, içindekier_başlıklar) = "" Then
            Rows(i).EntireRow.Hidden = True
            GoTo sonraki
        End If

sonraki:
    Next i
    i = Empty


    For i = içindekiler_başlangıç To Cells(içindekiler_bitiş + 1, içindekier_başlıklar).End(3).Row

        If Rows(i).EntireRow.Hidden = False Then

            For a = sayfalar_başlangıç To Cells(Rows.Count, sayfa_başlıklar).End(3).Row
                If Cells(i, içindekier_başlıklar) = Cells(a, sayfa_başlıklar) Then

                    If Rows(a).EntireRow.Hidden = True Then Rows(i).EntireRow.Hidden = True

                    sat = Cells(a, sayfa_başlıklar).Row
                    süt = Cells(a, sayfa_başlıklar).Column

                    If ActiveSheet.PageSetup.Order = xlDownThenOver Then
                        YataySay = ActiveSheet.HPageBreaks.Count + 1
                        DikeySay = 1
                    Else
                        DikeySay = ActiveSheet.VPageBreaks.Count + 1
                        YataySay = 1
                    End If
                    SayfaNo = 1
                    For Each Dikey In ActiveSheet.VPageBreaks
                        If Dikey.Location.Column > süt Then Exit For
                        SayfaNo = SayfaNo + YataySay
                    Next Dikey
                    For Each Yatay In ActiveSheet.HPageBreaks
                        If Yatay.Location.Row > sat Then Exit For
                        SayfaNo = SayfaNo + DikeySay
                    Next Yatay

                    Cells(i, sayfa_no_sütunu) = SayfaNo

                    Exit For

                End If
            Next a


        End If
    Next i
    ActiveWindow.View = xlNormalView
    MsgBox "B i t t i "
End Sub
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst