• DİKKAT

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

Hücre değerindeki seçim alanına göre yazdırma makrosu ihtiyacı

Katılım
9 Nisan 2015
Mesajlar
494
Excel Vers. ve Dili
2003 TÜRKÇE EXCEL
Değerli forum üyeleri;
HÜCRE DEĞERİNDEKİ SEÇİM ALANINA GÖRE YAZDIRMA MAKROSU İHTİYACIM VAR.

Konu hakındaki detay açıklama ekli dosyadadır.

BİLGİ isimli sayfada C2 hücresi değişken olarak seçim yapılınca YAZSAYFA isimli sayfadaki ekle/ad/tanımla bölümünde aralıkları verilmiş alanları sadece a4 kağıdının 1/5 denk gelecek alana sadece yazdırılması makrosu ihtiyacım var.
c2 hücresindeki değer değişikliğinde a4 kağıdının yazdırıldığı bölümde değişmesi gerekecek.

Yardımınız için şimdiden teşekkür ederim.
 

Ekli dosyalar

Kod:
Sub Yazdır()
    For Each nm In ActiveWorkbook.Names
        If WorksheetFunction.Proper([BİLGİ!C3]) = WorksheetFunction.Proper(nm.Name) Then
            adr = nm.RefersToRange.Address
            Exit For
        End If
    Next nm
    With Sheets("YAZSAYFA")
        With .PageSetup
            .PrintArea = adr
            .TopMargin = Range(.PrintArea).Top
        End With
        .PrintPreview
    End With
End Sub
 
Sayın veyselemre teşekkür ederim.
Ancak 5nci alan yazırılması seçince alan tam gelmiyor. YAZSAYFA 3 sayfa haline dönüyor ve gerekli satırlar gelmiyor.
yazdırma denemesinde 2 nci seçimden sonra ,3, 4, 5 satır kaydırarark yazdığı için 5 alan aşağı kaymış oluyor...
2 alan yazdırmada 2 satır; 3 alan yazdırmada 3 satır; 4 alan yazdırmada 8 satır; 5 alan yazdırmada 10 satır aşağıya kaymış olduğunu gördüm.

BİLGİ C2 hücresine bir kaç kez 1,2,3,4,5 veya 3,2,1,5,4 gibi değişkenlikler sonucunda
makronun ( .TopMargin = Range(.PrintArea).Top ) bölümünde hata oluyor.

lütfen tekrara bakar mısınız? Ayrıca yaz sayfada düzenleme yapınca sorun olur mu?
 
Son düzenleme:
Sayfanın üst marj ayarını manuel olarak düzenleyin.
Kod:
Sub Yazdır()
    Select Case [BİLGİ!C2]
    Case "tümsayfa", 1
        topMarg = 30
    Case 2
        topMarg = 190
    Case 3
        topMarg = 340
    Case 4
        topMarg = 490
    Case 5
        topMarg = 640
    End Select
    For Each nm In ActiveWorkbook.Names
        If WorksheetFunction.Proper([BİLGİ!C3]) = WorksheetFunction.Proper(nm.Name) Then
            adr = nm.RefersToRange.Address
            Exit For
        End If
    Next nm
    With Sheets("YAZSAYFA")
        With .PageSetup
            .PrintArea = adr
            .TopMargin = topMarg
        End With
        .PrintPreview
    End With
End Sub
 
Geri
Üst