• DİKKAT

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

Fonksiyon veya koşula bağlı Üst bilgi ve Alt bilgi

E

Ergün Güler

Katılım
5 Ocak 2009
Mesajlar
1,586
Excel Vers. ve Dili
2003 Türkçe
Selam,
Bir excel dosyasının yazdırma alanındaki alt ve üst bilgileri fonksiyon veya koşula bağlı olarak düzenleyebilir miyiz?
Örneğin, A1'de bir metin olsun ve dosyayı yazdırdığımızda A1 deki metin sayfanın üst bilgisi olarak yazılsın. A1'deki metin değiştiği zaman üst bilgide değişsin.
veya üst bilgi bir formül sonucu oluşan koşullara göre değişen bir metin olsun.

İyi çalışmalar.
 
merhaba

bu işinizi görür mü?
Kod: 
Sub üstbilgi()
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = [a1]
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
    End With
End Sub
 
Selamlar,

Aşağıdaki kodu bu işlemi uygulayacağınız sayfanın kod bölümüne uygulayıp denermisiniz.

Kod: 
Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    Application.ScreenUpdating = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = "&""Tahoma,Kalın""&20" & Range("A1")
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
    End With
    Application.ScreenUpdating = True
End Sub
 
uzmanamele' Alıntı:
merhaba

bu işinizi görür mü?
Kod: 
Sub üstbilgi()
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = [a1]
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
    End With
End Sub
Genişletmek için tıkla ...

Sayın Uzmanamele,
çözüm için çok teşekür ederim. Ancak, A1 hücresindeki değer değişince yazdırma üst bilgisi değişmiyor. sayfa kod görüntüle diyorum. makroyu çalışrtır diyorum ancak öyle yenilebiyor. Nasıl yapabiliriz?
 
Korhan Ayhan' Alıntı:
Selamlar,

Aşağıdaki kodu bu işlemi uygulayacağınız sayfanın kod bölümüne uygulayıp denermisiniz.

Kod: 
Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    Application.ScreenUpdating = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = "&""Tahoma,Kalın""&20" & Range("A1")
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
    End With
    Application.ScreenUpdating = True
End Sub
Genişletmek için tıkla ...

Sayın Korhan Ayhan,
kodu ekledim ancak hata veriyor. ben 2003 excel kullanıyorum. bundan olabilir mi?
 
Selamlar,

Ekli dosyada kodun uyarlanmış halini bulabilirsiniz.
 

Ekli dosyalar

Sayın Korhan Ayhan,
Çok teşekkür ederim. gönderdiğiniz dosyadan yapıştırdım, oldu. Birebir aynı olmasına rağmen il gönderdiğini ile yapamamıştım. Herhalde benden kaynaklanıyordu. Müsaadenizle birkaç soru daha sorabilir miyim? yoksa yeni konu mu açmam gerekiyor?

Sorum şu:

Çok sütunlu bir tablom var. ve bu tabloyu otomatik süzme yapıyorum. Mesela ilk sütunda benim istediğim satırlar için "1" yazıyor.
Ben de tablonun tamamı için "tümü" seçeneğini istediklerim için "1" seçeneğini seçiyorum. İstediğim şu mesela ben 1 seçerek süzme yaptığım zaman yazdırma üst bilgisinde " sadece bakım gerekenler" yazsın. "tümü" şeçtiğim zaman tüm bakımlar" diye yazsın. böyle birşey mümkün müdür?
Kolay gelsin.
 
Selamlar,

Konuyla ilgili örnek dosya eklermisiniz.
 
Korhan Ayhan' Alıntı:
Selamlar,

Konuyla ilgili örnek dosya eklermisiniz.
Genişletmek için tıkla ...
Dosya Ektedir.
"PeriyodikBakımlar" sayfasındaki A sütununda "1" olanlar sadece bakım gelenlerdir.
buradaki "1"ler "Sayaç sorgulama" sayfasındaki sonuşlara göre gelmektedir.
Ben sadece bakımı gelenleri yazıcıdan çıktı almak için A sütunundaki süzmeyi kullanarak "1" seçiyorum ve yazdırıyorum. işte bu esnada yazıcıdan çıktı alırken yazdırma üst bilgisinde istediğim bir metinin görünmesini örnek " bakım gerekenler" gibi. "tümü" seçtiğimde ya şuan mevcut olan üst bilgiyi veya yine isteğe bağlı bir üst bilgiyi yazıcı çıktısında görmek istiyorum.
Kolay gelsin.
 

Ekli dosyalar

Merhaba,

ThisWorbook sayfasına kopyalayarak denermisiniz..

Kod: 
Private Sub Workbook_BeforePrint(Cancel As Boolean)
Application.ScreenUpdating = False
 
If ActiveSheet.FilterMode = True Then
    ActiveSheet.PageSetup.CenterHeader = "&""Tahoma,Kalın""&20" _
    & Range("A1")
Else
    ActiveSheet.PageSetup.CenterHeader = "&""Tahoma,Kalın""&20" & _
    "Belirleyiniz.!"
End If
 
Application.ScreenUpdating = True
End Sub

.
 
Selamlar,

Süzme işleminde sayfa üzerinde çalışan bir olay yoktur. Sayfada bir tetikleme işlemi yapılması gerekiyordur. Bunun için AA1 hücresine basit bir alttoplam formülü uyguladım. Bu hücreyi silmeyiniz. Sayfada filtre uygulayıp dosyayı deneyin.
 

Ekli dosyalar

Ömer' Alıntı:
Merhaba,

ThisWorbook sayfasına kopyalayarak denermisiniz..

Kod: 
Private Sub Workbook_BeforePrint(Cancel As Boolean)
Application.ScreenUpdating = False
 
If ActiveSheet.FilterMode = True Then
    ActiveSheet.PageSetup.CenterHeader = "&""Tahoma,Kalın""&20" _
    & Range("A1")
Else
    ActiveSheet.PageSetup.CenterHeader = "&""Tahoma,Kalın""&20" & _
    "Belirleyiniz.!"
End If
 
Application.ScreenUpdating = True
End Sub

.
Genişletmek için tıkla ...

Sayın Ömer,
Yukarıdaki kodları sayfanın kod görüntülenen yerine yapıştırdım ancak olmadı.
Çok özür dülerim ben Makro bilmediğimden olabilir.
Çok özür dilerim. ThisWorbook sayfası nedir nasıl bulup yapıştıracağım?
Önce fonksiyonları öğreniyorum. Makro ve VBA bilmiyorum, ancak öğrenmek istiyorum.
 
Excel sayfasını açınca Araçlar / Makro / Visual Basic Düzenleyicisi ekranına ( Kısayol tuşu Alt F11 dir) girerseniz sol tarafta sayfa isimlerini ve sayfa isimlerinin hemen bitiminde ThisWorbook adlı bir sayfa görürsünün bu isim üzerine çift tıklarsanız önünüze bir ekran gelir kodları bu sayfaya yapıştırmanız yeterli olur..

.
 
Sayın Ömer,
Gönderdiğiniz çözüm çok güzel çalışıyor.Tam istediğim gibi. Ancak, çalışma kitabındaki tüm sayfaların üst bilgilerini değiştiriyor. sizleri de fazla meşgul etmek istemiyorum. Yardımlarınız için çok teşekkür ederim.
 
Korhan Ayhan' Alıntı:
Selamlar,

Süzme işleminde sayfa üzerinde çalışan bir olay yoktur. Sayfada bir tetikleme işlemi yapılması gerekiyordur. Bunun için AA1 hücresine basit bir alttoplam formülü uyguladım. Bu hücreyi silmeyiniz. Sayfada filtre uygulayıp dosyayı deneyin.
Genişletmek için tıkla ...

Sayın Korhan Ayhan,
Gece çalıştığımdan cevaplara geç yetişiyorum. Kusura bakmayın.
ek dosyanızı inceledim. Çok iyi çalışıyor. süzme yapınca üst bilgi için açılan pencere de çok güzel olmuş. Ancak, ben pencerenin açılmasını iptal etsem ve sabit bir metin yazılmasını istesem nasıl yapabilirim?
Sizi de fazla yormak istemiyorum. Yardımlarınız için çok teşekkür ederim.
 
Selamlar,

Üstteki mesajımdaki dosyada gerekli düzeltmeleri yaptım. İncelermisiniz.

Kod içindeki tırnak içindeki verileri hücrelerden aldırmak için Range("A1") şeklinde ifadeler kullanabilirsiniz.
 
ergunguler76@' Alıntı:
Sayın Ömer,
Gönderdiğiniz çözüm çok güzel çalışıyor.Tam istediğim gibi. Ancak, çalışma kitabındaki tüm sayfaların üst bilgilerini değiştiriyor. sizleri de fazla meşgul etmek istemiyorum. Yardımlarınız için çok teşekkür ederim.
Genişletmek için tıkla ...

Haklısınız o kısmı atlamışım.

Bu şekilde sadece belirlediğiniz sayfada çalışır.

Kod: 
Private Sub Workbook_BeforePrint(Cancel As Boolean)
Application.ScreenUpdating = False
Set s1 = Sheets("PeriyodikBakımlar")
 
If s1.FilterMode = True Then
    s1.PageSetup.CenterHeader = "&""Tahoma,Kalın""&20" & Range("A1")
Else
    s1.PageSetup.CenterHeader = "&""Tahoma,Kalın""&20" & "Belirleyiniz.!"
End If
 
Application.ScreenUpdating = True
End Sub

Bu şekilde kullanırsanız ise hem belirlediğiniz sayfada çalışır hemde filtre uygulanmadığı zaman InputBox dan seçim yapma imkanı sağlar.

Size uygun olanı kullanırsınız..

Kod: 
Private Sub Workbook_BeforePrint(Cancel As Boolean)
Application.ScreenUpdating = False
Set s1 = Sheets("PeriyodikBakımlar")
 
If s1.FilterMode = True Then
    s1.PageSetup.CenterHeader = "&""Tahoma,Kalın""&20" & Range("A1")
Else
    a = InputBox("İsmi Belirleyiniz.!", "Ön İzleme")
    s1.PageSetup.CenterHeader = "&""Tahoma,Kalın""&20" & a
End If
 
Application.ScreenUpdating = True
End Sub
 
Sayın Korhan Ayhan,
16.sıradaki mesajınızda bahsettiğiniz örnek dosyayı inceledim. Tam istediğim gibi olmuş. Sayın Ömer'in son çözümü farklı olsa da aynı işi yapıyor. Sizleri çok yordum. Çok teşekkürler. Ellerinize sağlık.
İyi çalışmalar,
Kolay gelsin.
 
Sayın Ömer,
17.sıradaki çözümleriniz tam istediğim gibi olmuş. Ben birinciyi kullanmayı tercih ettim. Sizleri çok yordum. Gerçekten harikasınız. Çok teşekkürler, ellerinize sağlık.
İyi çalışmalar,
Kolay gelsin.
 
Arkadaşlar yukarıdaki formülleri bende kullanıyorum ama benim şöyle bir sorunum oldu. Benim alacağım bilgiler sayfa1 de b54:b58 arası ve kullanacağım yer ise sayfa2'de Worksheets("Sayfa1").Range("B48:B51") yazdığımda hata alıyorum bunu nasıl düzeltebilirim.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst