Buton ile Yazdırma alanına Sayfa ekleme

pckatil

Altın Üye
Katılım
24 Ocak 2008
Mesajlar
28
Excel Vers. ve Dili
2003
Merhaba Arkadaşlar;

Çalıştığım excelde buton bastığımda sayfa2 nin aynısını eklemesini istiyorum. Bu sayfalar 2 3 4 şeklinde her bastığımda bir sonraki sayfanın altına ekletmem mümkünmüdür?

Çalışma kitabını ek olarak ekliyorum.

Şimdiden teşekkürler.
 

Ekli dosyalar

pckatil

Altın Üye
Katılım
24 Ocak 2008
Mesajlar
28
Excel Vers. ve Dili
2003
Yardımcı olabilecek kimse yokmu? En azından yol gösterseniz oda yeterli
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,333
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Deneyiniz.

Kod:
Option Explicit

Sub Yazdirma_Alanina_Sayfa_ekle()
    Dim Bul As Range, Adres As String, Say As Integer
    
    Rows("51:100").Copy Cells(Rows.Count, 1).End(3)(46, 1)
    ActiveSheet.PageSetup.PrintArea = "$A:$Y"
    With ActiveSheet.PageSetup
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1000
    End With
    ActiveSheet.ResetAllPageBreaks
    Set Bul = Cells.Find("HUB", , , xlWhole)
    If Not Bul Is Nothing Then
        Adres = Bul.Address
        Do
            Say = Say + 1
            Set ActiveSheet.HPageBreaks(Say).Location = Bul.Offset(-1, 0)
            Set Bul = Cells.FindNext(Bul)
        Loop While Not Bul Is Nothing And Bul.Address <> Adres
    End If

    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
 

pckatil

Altın Üye
Katılım
24 Ocak 2008
Mesajlar
28
Excel Vers. ve Dili
2003
Kod için çok teşekkür ederim. Çok işime yaradı. Sadece yeni sayfa ekle dediğimde sayfanın sağ tarafında 2 adet butonum var onlarıda ekliyor. Bunu düzeltebilirmiyim ve o iki butonu sayfa ile birlikte aşağı yukarı hareketini sağlıyabilirmiyim? bide bu iki butonu pencere içine almak istiyorum. Ayrı bir program havasında.
 

Ekli dosyalar

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,333
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Sayfadaki butonlarınızı bir Userform üzerine ekleyip kullanırsanız istediğiniz sonuca ulaşabilirsiniz.

Forumda userform örnekleri bolca var.
 

pckatil

Altın Üye
Katılım
24 Ocak 2008
Mesajlar
28
Excel Vers. ve Dili
2003
Kod için tekrar teşekkür ederim. Sizin verdiğiniz şekilde kodları uyguladım. Buton sabitleme işlemini bölüm dondurma ile çözdüm gibi ama sayfa ekle butonuna bastığımda sayfa ekliyor lakin ilk satırdaki dondurulmuş alanıda yazdırma alanının içine alıyor ve ilk sayfadaki yazdırma alanı bir satır yukarı kayıyor. Bunu nasıl düzeltebilirim. Birde yeni sayfa ekle dediğimde sayfa 2 ye eklediğim resimleride yeni sayfaya ekliyor sadece hücre biçimini ekletme şansım varmı?
 

Ekli dosyalar

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,333
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Deneyiniz.

Kod:
Option Explicit

Sub Yazdirma_Alanina_Sayfa_ekle()
    Dim Bul As Range, Adres As String, Say As Integer, Alan As Range, Nesne As Object
    
    Rows("52:101").Copy Cells(Rows.Count, 1).End(3)(46, 1)
    
    Set Alan = Cells(Rows.Count, 1).End(3).Resize(44, 25)
    
    For Each Nesne In ActiveSheet.DrawingObjects
        If Not Intersect(Alan, Range(Nesne.TopLeftCell, Nesne.BottomRightCell)) Is Nothing Then
            Nesne.Delete
        End If
    Next
    
    ActiveSheet.PageSetup.PrintArea = "$A$2:$Y$" & Cells(Rows.Count, 1).End(3)(44, 1).Row
    With ActiveSheet.PageSetup
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1000
    End With
    ActiveSheet.ResetAllPageBreaks
    Set Bul = Cells.Find("HUB", , , xlWhole)
    If Not Bul Is Nothing Then
        Adres = Bul.Address
        Do
            Say = Say + 1
            Set ActiveSheet.HPageBreaks(Say).Location = Bul.Offset(-1, 0)
            Set Bul = Cells.FindNext(Bul)
        Loop While Not Bul Is Nothing And Bul.Address <> Adres
    End If

    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
 

pckatil

Altın Üye
Katılım
24 Ocak 2008
Mesajlar
28
Excel Vers. ve Dili
2003
Kod için çok teşekkürler. Bir sorum daha olacaktı. Buton yardımı ile yazdırma alanındaki son sayfayı nasıl sildirebilirim.
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,333
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Deneyiniz.

Kod:
Sub Yazdirma_Alanindaki_Son_Sayfayi_Sil()
    Dim X As Long, Y As Long
    X = ActiveSheet.HPageBreaks(ActiveSheet.HPageBreaks.Count).Location.Row
    Y = X + 48
    Range("A" & X & ":A" & Y).EntireRow.Delete
End Sub
 
Üst