Yazdır makrosu

Erdal · 25 Ağustos 2014

Merhabalar
Amacım işaretlemiş olduğum sayfaları yazdırma alanı belirleyerek yazdırmak. Bunun için de makro kaydet yöntemini kullandım ama bazı şeyleri beceremedim ayrıca da hata mesajı aldım. Şöyle ki;
- Makro 1 ile toplam 14 sayfa yazdırmak istiyorum. Yazdır butonuna tıkladığımda bu 14 sayfa yazdırılacak. Seçtiğim alan sığmıyorsa yazdırma alanı belirleyerek sığdırıp yazdırılacak. (6,7 ve 12. Sayfalar yatay diğerleri dikey yazdırılacak) Ben bunları makro kaydet ile yaptım ve bir commandbutona atadım. Butonu tıklayınca 1. Sayfanın baskı ön izlemesi ekrana geliyor ve orada takılıyor. Ancak baskı ön izlemeyi kapatınca 1. Sayfayı yazdırıyor ve 2. Sayfanın baskı ön izlemesi ekrana geliyor ve bu şekilde devam edip gidiyor.
- Makro 2 ile de toplam 13 sayfa yazdırmak istiyorum. Bunda da mantık aynı şekilde. . (6,7 ve 12. Sayfalar yatay diğerleri dikey yazdırılacak) Fakat butona tıkladığımda örnekteki hatayı alıyorum.
- Ayrıca butona bastığımızda önce kaç nüsha yazdırmak istediğimi sorsun. (Hiç bir şey yazmazsam mümkünse 1 kabul etsin) Sonrasında ise yazdırsın. Kodlara bu eklenebilir mi?

halit3 · 25 Ağustos 2014

kod:

Kod:

Sub yazdır1()


ReDim yön(14)
ReDim yaz(14)

yön(1) = xlPortrait 'dikey
yön(2) = xlPortrait 'dikey
yön(3) = xlPortrait 'dikey
yön(4) = xlPortrait 'dikey
yön(5) = xlPortrait 'dikey
yön(6) = xlLandscape 'yatay
yön(7) = xlLandscape 'yatay
yön(8) = xlPortrait 'dikey
yön(9) = xlPortrait 'dikey
yön(10) = xlPortrait 'dikey
yön(11) = xlPortrait 'dikey
yön(12) = xlLandscape 'yatay
yön(13) = xlPortrait 'dikey
yön(14) = xlPortrait 'dikey


yaz(1) = "$A$3:$I$51"
yaz(2) = "$M$3:$V$72"
yaz(3) = "$M$74:$V$143"
yaz(4) = "$Z$3:$AK$64"
yaz(5) = "$AO$2:$BJ$55"
yaz(6) = "$BN$3:$CU$50"
yaz(7) = "$CY$2:$DT$49"
yaz(8) = "$DX$4:$EK$39"
yaz(9) = "$DX$59:$EK$93"
yaz(10) = "$DX$100:$EK$130"
yaz(11) = "$DX$138:$EK$166"
yaz(12) = "$BO$4:$FD$49"
yaz(13) = "$FH$3:$FK$57"
yaz(14) = "$FV$3:$FY$57"


adet = Application.InputBox("Yazdırmak İstiyormusunuz.", "Yazdırılacak kadar sayı giriniz.", "1", 400, 30, , Type:=1)
    
If adet = False Then
MsgBox "İşlemi iptal ettiniz"
Exit Sub
End If


[COLOR="red"]ActiveSheet.PageSetup.Zoom = False[/COLOR]
For i = 1 To 14
Worksheets(ActiveSheet.Name).PageSetup.Orientation = yön(i)
Worksheets(ActiveSheet.Name).PageSetup.PrintArea = yaz(i)
ActiveWindow.SelectedSheets.PrintPreview
Worksheets(ActiveSheet.Name).PrintOut Copies:=adet, Collate:=True
Next i
[COLOR="Red"]Worksheets(ActiveSheet.Name).PageSetup.PrintArea = ""[/COLOR]

MsgBox ("işlem tamam."), vbInformation, "UYARI"

End Sub

Erdal · 26 Ağustos 2014

halit3' Alıntı:

kod:

Kod:

Sub yazdır1()


ReDim yön(14)
ReDim yaz(14)

yön(1) = xlPortrait 'dikey
yön(2) = xlPortrait 'dikey
yön(3) = xlPortrait 'dikey
yön(4) = xlPortrait 'dikey
yön(5) = xlPortrait 'dikey
yön(6) = xlLandscape 'yatay
yön(7) = xlLandscape 'yatay
yön(8) = xlPortrait 'dikey
yön(9) = xlPortrait 'dikey
yön(10) = xlPortrait 'dikey
yön(11) = xlPortrait 'dikey
yön(12) = xlLandscape 'yatay
yön(13) = xlPortrait 'dikey
yön(14) = xlPortrait 'dikey


yaz(1) = "$A$3:$I$51"
yaz(2) = "$M$3:$V$72"
yaz(3) = "$M$74:$V$143"
yaz(4) = "$Z$3:$AK$64"
yaz(5) = "$AO$2:$BJ$55"
yaz(6) = "$BN$3:$CU$50"
yaz(7) = "$CY$2:$DT$49"
yaz(8) = "$DX$4:$EK$39"
yaz(9) = "$DX$59:$EK$93"
yaz(10) = "$DX$100:$EK$130"
yaz(11) = "$DX$138:$EK$166"
yaz(12) = "$BO$4:$FD$49"
yaz(13) = "$FH$3:$FK$57"
yaz(14) = "$FV$3:$FY$57"


adet = Application.InputBox("Yazdırmak İstiyormusunuz.", "Yazdırılacak kadar sayı giriniz.", "1", 400, 30, , Type:=1)
    
If adet = False Then
MsgBox "İşlemi iptal ettiniz"
Exit Sub
End If

For i = 1 To 14
ActiveSheet.PageSetup.Orientation = yön(i)
Worksheets(ActiveSheet.Name).PageSetup.PrintArea = yaz(i)
Worksheets(ActiveSheet.Name).PrintOut Copies:=adet, Collate:=True
Next i

MsgBox ("işlem tamam."), vbInformation, "UYARI"

End Sub

İlginiz için teşekkür ederim Halit Bey
Aşağıdaki husularda yardımcı olabilir misiniz acaba?
- 12. sayfa BO4-FD49 arası değilde EO4-FD49 arası olack. Ben EO4 yazdığım halde yazıcıdan gene BO4 diye çıkıyor.
- Yazdırma işlemine başlamadan evvel sayfadaki tüm dolgu renklerini "dolgu yok seçeneği ile kaldırmak için kodları nasıl revize ederiz.
- İşlem tamam mesaj kutusunu kaldırabilir miyiz?
- 2 sayfasındaki butonda 13 sayfa var. Vermiş olduğunuz kodlardaki yön(14) = xlPortrait 'dikey, yaz(14) = "$FV$3:$FY$57" satırlarını silmem ve For i = 1 To 14 satırını 13 yapmam yeterlimidir? Saygı ve selam ile ...

Erdal · 26 Ağustos 2014

1-3 ve 4. maddeleri hallettim. Sadece yazdırmaya başlamadan evvel sayfadaki dolgu renklerinin dolgu yok şeklinde ayarlanması ile ilgili 2. madde kaldı. Bu konuda yardımcı olabilir misiniz?

YUSUF44 · 26 Ağustos 2014

dolgu olayı için sayın halit3'ün kodlarındaki :

Kod:

For i = 1 To 14
ActiveSheet.PageSetup.Orientation = yön(i)
Worksheets(ActiveSheet.Name).PageSetup.PrintArea = yaz(i)
Worksheets(ActiveSheet.Name).PrintOut Copies:=adet, Collate:=True
Next i

bölümünü aşağıdaki gibi değiştirerek dener misiniz?

Kod:

For i = 1 To 14
Range(yaz(i)).Select
With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
End With
ActiveSheet.PageSetup.Orientation = yön(i)
Worksheets(ActiveSheet.Name).PageSetup.PrintArea = yaz(i)
Worksheets(ActiveSheet.Name).PrintOut Copies:=adet, Collate:=True
Range(yaz(i)).Select
With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.149998474074526
        .PatternTintAndShade = 0
End With
Next i

Erdal · 26 Ağustos 2014

İlginiz için teşekkür ederim Yusuf Bey. Tam istediğim gibi.

Erdal · 26 Ağustos 2014

YUSUF44' Alıntı:

dolgu olayı için sayın halit3'ün kodlarındaki :

Kod:

For i = 1 To 14
ActiveSheet.PageSetup.Orientation = yön(i)
Worksheets(ActiveSheet.Name).PageSetup.PrintArea = yaz(i)
Worksheets(ActiveSheet.Name).PrintOut Copies:=adet, Collate:=True
Next i

bölümünü aşağıdaki gibi değiştirerek dener misiniz?

Kod:

For i = 1 To 14
Range(yaz(i)).Select
With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
End With
ActiveSheet.PageSetup.Orientation = yön(i)
Worksheets(ActiveSheet.Name).PageSetup.PrintArea = yaz(i)
Worksheets(ActiveSheet.Name).PrintOut Copies:=adet, Collate:=True
Range(yaz(i)).Select
With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.149998474074526
        .PatternTintAndShade = 0
End With
Next i

Yusuf Bey tahmin edemediğim şöyle bir problem oldu; acaba yazdırma işlemine başlamadan sayfa yapısından kenar boşluklarını (Evvelki ne olursa olsun) sol= 1,8 alt ve üst = 1 olarak ayarlamak için kodlara nasıl bir ilave yapmak gerekir.

YUSUF44 · 26 Ağustos 2014

İlk End With satırından sonra aşağıdaki kodları ilave edip dener misiniz?

Kod:

With ActiveSheet.PageSetup
        .LeftMargin = Application.InchesToPoints(0.708661417322835)
        .TopMargin = Application.InchesToPoints(0.393700787401575)
        .BottomMargin = Application.InchesToPoints(0.393700787401575)
End With

Erdal · 28 Ağustos 2014

YUSUF44' Alıntı:
İlk End With satırından sonra aşağıdaki kodları ilave edip dener misiniz?

Kod:

With ActiveSheet.PageSetup .LeftMargin = Application.InchesToPoints(0.708661417322835) .TopMargin = Application.InchesToPoints(0.393700787401575) .BottomMargin = Application.InchesToPoints(0.393700787401575) End With

Merhabalar Yusuf Bey
İşlerin yoğunluğundan geri dönüş yapamadım. Kusura bakmayın.
Verilen kodları orjinal dosyaya atınca yazdırma alanı belirleme işi hata veriyor. (Örnek dosyada bir sıkıntı yok). Kenar boşluklarını ayarlama ve dolgu rengini ayarlama işlerinde bir sıkıntı yok sadece istediğim alanları yazmıyor. Orjinal dosyayı yolluyorum. acaba yardımcı olabilir misiniz. saygı ve selam ile...

YUSUF44 · 28 Ağustos 2014

Bunun nedeni kenar boşluklarınızın ve kağıt ebadınızın seçili alanlara uymaması diye düşünüyorum. Örneğin 2. sayfa olarak belirlenen alan 4 sayfaya sığıyor. Dolayısıyla yazdırma işi de istediğiniz gibi olmuyor. Sorunu düzeltmek için Satır yükseklikleriyle ve sütun genişliklerini değiştirmeniz gerekir.

Şimdi baktım, örnek dosyanızda sayfayı 1 sayfaya sığdır seçeneği seçili, asıl dosyanızda ise bu seçili değil. Aynı şeyi asıl dosyanızda da yaparsanız sorun düzelir galiba.

Erdal · 29 Ağustos 2014

YUSUF44' Alıntı:
Bunun nedeni kenar boşluklarınızın ve kağıt ebadınızın seçili alanlara uymaması diye düşünüyorum. Örneğin 2. sayfa olarak belirlenen alan 4 sayfaya sığıyor. Dolayısıyla yazdırma işi de istediğiniz gibi olmuyor. Sorunu düzeltmek için Satır yükseklikleriyle ve sütun genişliklerini değiştirmeniz gerekir.

Şimdi baktım, örnek dosyanızda sayfayı 1 sayfaya sığdır seçeneği seçili, asıl dosyanızda ise bu seçili değil. Aynı şeyi asıl dosyanızda da yaparsanız sorun düzelir galiba.

İlginiz için teşekkürler Yusuf Bey
Benim yapmak istediğim de bu zaten, her sayfa için yazdırma alanını belirleyerek sığdır deyip yazdırmak. Ama bunu her sayfa için tek tek yapmamak adına bir kod aracılığıyla otomatik olsun istiyorum.

YUSUF44 · 29 Ağustos 2014

Yazdırmayla ilgili satırdan (içinde printout geçen satır) önce aşağıdaki kodu ilave edip dener misiniz:

Kod:

With ActiveSheet.PageSetup
        .FitToPagesWide = 1
        .FitToPagesTall = 1
End With

Erdal · 29 Ağustos 2014

YUSUF44' Alıntı:
Yazdırmayla ilgili satırdan (içinde printout geçen satır) önce aşağıdaki kodu ilave edip dener misiniz:

Kod:

With ActiveSheet.PageSetup .FitToPagesWide = 1 .FitToPagesTall = 1 End With

Vermiş olduğunuz kodu ilave ettim. 1. sayfayı doğru yazdırıyor ama 2. sayfayı yine aynı şekilde yazdırıyor. Kodları ilave ettiğim şekilde orjinal dosyayı tekrar ekliyorum. Bakabilirseniz sevinirim. Saygı ve selam ile...

YUSUF44 · 29 Ağustos 2014

Sayfa1'deki Komut düğmesinin kodlarını aşağıdaki şekle dönüştürüp 1-2. sayfaları ve 3-4. sayfaları ayrı ayrı denedim, her iki durumda da sayfaları bir sayfaya sığdırarak yazdı. Tabi her seferinde 14 sayfa yazdırmamak için kodlardaki kırmızı bölümü istediğim sayfalara göre değiştirdim.

Kod:

Private Sub CommandButton1_Click()
Range("Q111,M136,BN8,BN10,BN12,BN14,BN16,BN22,BN24,BN26,BN28,BN30,BN36,BN38,BN40,BN42,BN44,DR7:DS37,EO24:FB33").Select
With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With ActiveSheet.PageSetup
        .LeftMargin = Application.InchesToPoints(0.708661417322835)
        .TopMargin = Application.InchesToPoints(0.393700787401575)
        .BottomMargin = Application.InchesToPoints(0.393700787401575)
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With
Range("M4").Activate
ReDim yön(14)
ReDim yaz(14)

yön(1) = xlPortrait 'dikey
yön(2) = xlPortrait 'dikey
yön(3) = xlPortrait 'dikey
yön(4) = xlPortrait 'dikey
yön(5) = xlPortrait 'dikey
yön(6) = xlLandscape 'yatay
yön(7) = xlLandscape 'yatay
yön(8) = xlPortrait 'dikey
yön(9) = xlPortrait 'dikey
yön(10) = xlPortrait 'dikey
yön(11) = xlPortrait 'dikey
yön(12) = xlLandscape 'yatay
yön(13) = xlPortrait 'dikey
yön(14) = xlPortrait 'dikey


yaz(1) = "$A$3:$I$51"
yaz(2) = "$M$3:$V$72"
yaz(3) = "$M$74:$V$143"
yaz(4) = "$Z$3:$AK$64"
yaz(5) = "$AO$2:$BJ$55"
yaz(6) = "$BN$3:$CU$50"
yaz(7) = "$CY$2:$DT$49"
yaz(8) = "$DX$4:$EK$39"
yaz(9) = "$DX$59:$EK$93"
yaz(10) = "$DX$100:$EK$130"
yaz(11) = "$DX$138:$EK$166"
yaz(12) = "$EO$4:$FD$49"
yaz(13) = "$FH$3:$FK$57"
yaz(14) = "$FV$3:$FY$57"


adet = Application.InputBox("Yazdırmak İstiyormusunuz.", "Yazdırılacak kadar sayı giriniz.", "1", 400, 30, , Type:=1)
    
If adet = False Then
MsgBox "İşlemi iptal ettiniz"
Exit Sub
End If

For i = [COLOR=Red][B]1 To 14[/B][/COLOR]
ActiveSheet.PageSetup.Orientation = yön(i)
Worksheets(ActiveSheet.Name).PageSetup.PrintArea = yaz(i)
Worksheets(ActiveSheet.Name).PrintOut Copies:=adet, Collate:=True
Next i

End Sub

Erdal · 29 Ağustos 2014

YUSUF44' Alıntı:
Sayfa1'deki Komut düğmesinin kodlarını aşağıdaki şekle dönüştürüp 1-2. sayfaları ve 3-4. sayfaları ayrı ayrı denedim, her iki durumda da sayfaları bir sayfaya sığdırarak yazdı. Tabi her seferinde 14 sayfa yazdırmamak için kodlardaki kırmızı bölümü istediğim sayfalara göre değiştirdim.

1. sayfada zaten bir sıkıntı yok. Sıkıntı 2. sayfada. Vermiş olduğunuz kodları 2. sayfaya uyarladım ama yine aynı şekilde yazdırıyor.

YUSUF44 · 29 Ağustos 2014

İkinci sayfa derken ben sayfa adı 1 olan sayfada (sheet) 2. sayfanın sığmadığını düşünerek cevap vermiştim. Halbuki siz sayfa adı 2 olan sayfa için soruyormuşsunuz.

Bunu çözmek için öncelikle 2. sayfadaki yazdıma alanını iptal ettim. Sonra Sayfa yapısından tümünü bir sayfaya sığdır2ı seçtim. Daha sonra kodları çalıştırdığımda problemsi olarak yazdırdı:

Kod:

Private Sub CommandButton1_Click()
Range("M136,BN8,BN10,BN12,BN14,BN16,BN22,BN24,BN26,BN28,BN30,BN36,BN38,BN40,BN42,BN44,DR7:DS37,EO24:FB33").Select
With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With ActiveSheet.PageSetup
        .LeftMargin = Application.InchesToPoints(0.708661417322835)
        .TopMargin = Application.InchesToPoints(0.393700787401575)
        .BottomMargin = Application.InchesToPoints(0.393700787401575)
        .FitToPagesWide = 1
        .FitToPagesTall = 1
End With
Range("M4").Activate
ReDim yön(13)
ReDim yaz(13)

yön(1) = xlPortrait 'dikey
yön(2) = xlPortrait 'dikey
yön(3) = xlPortrait 'dikey
yön(4) = xlPortrait 'dikey
yön(5) = xlPortrait 'dikey
yön(6) = xlLandscape 'yatay
yön(7) = xlLandscape 'yatay
yön(8) = xlPortrait 'dikey
yön(9) = xlPortrait 'dikey
yön(10) = xlPortrait 'dikey
yön(11) = xlPortrait 'dikey
yön(12) = xlLandscape 'yatay
yön(13) = xlPortrait 'dikey


yaz(1) = "$A$3:$I$51"
yaz(2) = "$M$3:$V$72"
yaz(3) = "$M$74:$V$143"
yaz(4) = "$Z$3:$AK$64"
yaz(5) = "$AO$2:$BJ$55"
yaz(6) = "$BN$3:$CU$50"
yaz(7) = "$CY$2:$DT$49"
yaz(8) = "$DX$4:$EK$39"
yaz(9) = "$DX$59:$EK$93"
yaz(10) = "$DX$100:$EK$130"
yaz(11) = "$DX$138:$EK$166"
yaz(12) = "$EO$4:$FD$49"
yaz(13) = "$FV$3:$FY$57"


adet = Application.InputBox("Yazdırmak İstiyormusunuz.", "Yazdırılacak kadar sayı giriniz.", "1", 400, 30, , Type:=1)
    
If adet = False Then
MsgBox "İşlemi iptal ettiniz"
Exit Sub
End If

For i = 1 To 2
ActiveSheet.PageSetup.Orientation = yön(i)
Worksheets(ActiveSheet.Name).PageSetup.PrintArea = yaz(i)
Worksheets(ActiveSheet.Name).PrintOut Copies:=adet, Collate:=True
Next i
End Sub

Erdal · 29 Ağustos 2014

YUSUF44' Alıntı:
İkinci sayfa derken ben sayfa adı 1 olan sayfada (sheet) 2. sayfanın sığmadığını düşünerek cevap vermiştim. Halbuki siz sayfa adı 2 olan sayfa için soruyormuşsunuz.

Bunu çözmek için öncelikle 2. sayfadaki yazdıma alanını iptal ettim. Sonra Sayfa yapısından tümünü bir sayfaya sığdır2ı seçtim. Daha sonra kodları çalıştırdığımda problemsi olarak yazdırdı:

Evimde yazıcı olmadığı için pazartesine kadar deneme şansım yok. Olumlu yada olumsuz mutlaka geri dönüş yapacağım.
Yalnız birşey sormak istiyorum.
For i = 1 To 2 satırının For i = 1 To 13 olması gerekmiyor mu?
Saygı ve selam ile ...

YUSUF44 · 29 Ağustos 2014

Öyle değiştirebilirsiniz. Ben 13 sayfa yazdırmamak için öyle yapıp sadece ilk 2 sayfayı yazdırdım.

Erdal · 3 Eylül 2014

YUSUF44' Alıntı:
İkinci sayfa derken ben sayfa adı 1 olan sayfada (sheet) 2. sayfanın sığmadığını düşünerek cevap vermiştim. Halbuki siz sayfa adı 2 olan sayfa için soruyormuşsunuz.

Bunu çözmek için öncelikle 2. sayfadaki yazdıma alanını iptal ettim. Sonra Sayfa yapısından tümünü bir sayfaya sığdır2ı seçtim. Daha sonra kodları çalıştırdığımda problemsi olarak yazdırdı:

Biraz uğraşarak en sonunda becerdim. Yardımlarınız için teşekkür ederim.

AMEDİC · 13 Haziran 2019

Merhaba arkadaşlar,
excel veya Word de ilk bir kaç sayfayı ( örneğin ilk 4 sayfa ) tek taraflı, sonraki sayfaları çift taraflı ve 300 adet yazdırmak istiyorum. Acaba bunun için bi makro butonunu nasıl oluşturacağım hakkında bana yardımcı olabilir misiniz? İlginize şimdiden teşekkürler...

Yazdır makrosu

Erdal

Ekli dosyalar

halit3

Uzman

Erdal

Erdal

YUSUF44

Destek Ekibi

Erdal

Erdal

YUSUF44

Destek Ekibi

Erdal

Ekli dosyalar

YUSUF44

Destek Ekibi

Erdal

YUSUF44

Destek Ekibi

Erdal

Ekli dosyalar

YUSUF44

Destek Ekibi

Erdal

YUSUF44

Destek Ekibi

Erdal

YUSUF44

Destek Ekibi

Erdal

AMEDİC