Yazdırma alanı belirleyerek yazdır butonu yapmak

[Erdal]

Merhabalar
Yazdır butonu yapmak istiyorum. Önce fare ile yazdırılacak alanı seçeceğim. Daha sonra yazdır butonuna tıkladığımda ö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. Yalnız eğer seçtiğim alan sığmıyorsa yazdırma alanı belirleyerek sığdırıp yazdırsın. Böyle bir şey yapılabilir mi? Birde bu buton üstteki şeritte olabilir mi? Çünkü bu butonu tüm çalışma kitabında kullanmak istiyorum. (Sayfanın en üst satırında örneğin A1’de olmaz. Çünkü sayfalar sağa ve aşağıya doğru bayağı bir gidiyor. Buton sürekli göz önünde olsun istiyorum.)
Saygı ve selam ile ...

 

[Emir Hüseyin Çoban]

. . .

Aşağıdaki kodları eklenti haline getirip, klavyeden fonksiyon tuşlarına (örneğin F9) makroyu atarsanız, tüm çalışma kitaplarında kullanılır hâle getirebilirsiniz.

Sub kod()
    
    msj = InputBox("Hücre Aralığı : " & Chr(10) & Selection.Address, "Yazdırmak İstiyor Musun ?", "1")
    If msj = "" Then Exit Sub
    
    With ActiveSheet.PageSetup
        .PrintArea = Selection.Address
        .Zoom = False
    End With
    ActiveSheet.PrintOut copies:=msj
    
End Sub

. . .

 

[Erdal]

. . .

Aşağıdaki kodları eklenti haline getirip, klavyeden fonksiyon tuşlarına (örneğin F9) makroyu atarsanız, tüm çalışma kitaplarında kullanılır hâle getirebilirsiniz.

Sub kod()
    
    msj = InputBox("Hücre Aralığı : " & Chr(10) & Selection.Address, "Yazdırmak İstiyor Musun ?", "1")
    If msj = "" Then Exit Sub
    
    With ActiveSheet.PageSetup
        .PrintArea = Selection.Address
        .Zoom = False
    End With
    ActiveSheet.PrintOut copies:=msj
    
End Sub

. . .

Hüseyin Bey
Çok teşekkür ederim. Tam istediğim gibi olmuş. Yanlız evvelden düşünemediğim bir şey oldu. Bazı tablolarım enine bazıları boyuna bu yüzden kaç nüzha yazdırmak istediğimi sorduktan sonra baskı ön izleme sayfasına gitmek isteyip istemediğimi sorabilir mi? Hayır dersem direk yazdıracak. Evet dersem baskı ön izleme sayfaına gidecek ve ben yazdırma ayarlarını yaptıktan sonra yazdıracak.Saygı ve selam ile ...

 

[Emir Hüseyin Çoban]

. . .

Sub kod()
    msj = InputBox("Hücre Aralığı : " & Chr(10) & Selection.Address, "Yazdırmak İstiyor Musun ?", "1")
    If msj = "" Then Exit Sub
    
[COLOR="Blue"]    msj2 = MsgBox("Baskı Önizlemek İster Misiniz ?", vbYesNo)
    If msj2 = vbYes Then
        ActiveSheet.PrintPreview
    Else[/COLOR]
        With ActiveSheet.PageSetup
            .PrintArea = Selection.Address
            .Zoom = False
        End With
        ActiveSheet.PrintOut copies:=msj
    End If
End Sub

. . .

 

[Erdal]

. . .

Sub kod()
    msj = InputBox("Hücre Aralığı : " & Chr(10) & Selection.Address, "Yazdırmak İstiyor Musun ?", "1")
    If msj = "" Then Exit Sub
    
[COLOR="Blue"]    msj2 = MsgBox("Baskı Önizlemek İster Misiniz ?", vbYesNo)
    If msj2 = vbYes Then
        ActiveSheet.PrintPreview
    Else[/COLOR]
        With ActiveSheet.PageSetup
            .PrintArea = Selection.Address
            .Zoom = False
        End With
        ActiveSheet.PrintOut copies:=msj
    End If
End Sub

. . .

Sn Hüseyin Bey
Öncelikle ilginiz için teşekkür ederim. Şöyle bir hata alıyorum. Yazdıracağım alanı seçtikten sonra baskı önizleme seçeneğine de evet deyince yadırmak istediğim alan değil de dosyanın en başı (A1) ekrana geliyor.

 

[Erdal]

Daha anlaşılır olması için örnek ekledim.

 

[Emir Hüseyin Çoban]

. . .

Sub kod()
    msj = InputBox("Hücre Aralığı : " & Chr(10) & Selection.Address, "Yazdırmak İstiyor Musun ?", "1")
    If msj = "" Then Exit Sub
    
    ActiveSheet.PageSetup.PrintArea = Selection.Address
    
    msj2 = MsgBox("Baskı Önizlemek İster Misiniz ?", vbYesNo)
    If msj2 = vbYes Then
        ActiveSheet.PrintPreview
    Else
        ActiveSheet.PageSetup.Zoom = False
        ActiveSheet.PrintOut copies:=msj
    End If
    
End Sub

. . .

 

[Erdal]

. . .

Sub kod()
    msj = InputBox("Hücre Aralığı : " & Chr(10) & Selection.Address, "Yazdırmak İstiyor Musun ?", "1")
    If msj = "" Then Exit Sub
    
    ActiveSheet.PageSetup.PrintArea = Selection.Address
    
    msj2 = MsgBox("Baskı Önizlemek İster Misiniz ?", vbYesNo)
    If msj2 = vbYes Then
        ActiveSheet.PrintPreview
    Else
        ActiveSheet.PageSetup.Zoom = False
        ActiveSheet.PrintOut copies:=msj
    End If
    
End Sub

. . .

Teşekkür ederim Hüseyin Bey
Kodlar tam istediğim gibi. Yalnız bu kodları çalıştırıp dosyamı kapat dediğimde (Dosyayı kaydetme seçeneğini seçiyorum) microsoft excel çalışmayı durdurdu hatası alıyorum. Saygı ve selam ile...

 

[Emir Hüseyin Çoban]

. . .

Nasıl bir tabloda kullandığınızı bilmiyorum.
Ancak yukarıdaki kodlarda exceli hataya düşürecek bir işlem yok.

. . .

 

[Erdal]

. . .

Nasıl bir tabloda kullandığınızı bilmiyorum.
Ancak yukarıdaki kodlarda exceli hataya düşürecek bir işlem yok.

. . .

İlginiz için teşekkür ederim. Hakkınızı helal edin.

 

[Emir Hüseyin Çoban]

Helal olsun.

.

 

[ozkovlu]

hüseyin bey;
CheckBox ile seçmiş olduğum verileri nasıl çıktı alabilirim.

 

[Emre Çinkılınç]

. . .

Sub kod()
    msj = InputBox("Hücre Aralığı : " & Chr(10) & Selection.Address, "Yazdırmak İstiyor Musun ?", "1")
    If msj = "" Then Exit Sub
    
    ActiveSheet.PageSetup.PrintArea = Selection.Address
    
    msj2 = MsgBox("Baskı Önizlemek İster Misiniz ?", vbYesNo)
    If msj2 = vbYes Then
        ActiveSheet.PrintPreview
    Else
        ActiveSheet.PageSetup.Zoom = False
        ActiveSheet.PrintOut copies:=msj
    End If
    
End Sub

. . .

bunu arıyordum çok iyi oldu elinize sağlık. teşekkür ederim.