• DİKKAT

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

Seçili alanı yazıcıya gönderme

O

orange4609

Katılım
13 Temmuz 2011
Mesajlar
226
Excel Vers. ve Dili
türkçe
Merhabalar,

Ana sayfadaki linki çift tıkladığımda seçili alanda bulunan adresi "TEC B-SA4G"yazıcısına bir sayfaya sığdıracak şekilde gönderilmesini makroyla sağlayabilir miyiz?
dosya ekleyemiyorum aşağıdaki linkten dosyaya ulaşabiliriz.
(not:varsayılan yazıcı değil)

ilginize şimdiden tşkler.
iyi günler.

http://s3.dosya.tc/server4/i35DIY/Kopyas_ET_KETEADRESYAZDIRMA-.xls.html
 
Merhaba,

Aşağıdaki kodu linklerin olduğu sayfanızın kod bölümüne uygulayıp deneyiniz.

Kod: 
Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
    Varsayilan_Printer = Application.ActivePrinter
    Adres = ActiveWindow.RangeSelection.Address
    If InStr(Trim(Adres), ":") = 0 Then MsgBox "Yazdırılacak alan seçimi yapmadınız!": Exit Sub
    Onay = MsgBox("Yazdırma işlemine devam etmek istiyor musunuz?", vbYesNo, "Uyarı")
    If Onay = vbYes Then
        Application.ActivePrinter = "Ne00: üzerindeki Lexmark T650 "
        Worksheets(ActiveSheet.Name).PageSetup.PrintArea = Adres
        Worksheets(ActiveSheet.Name).PrintOut Copies:=1, Collate:=True
    End If
    Application.ActivePrinter = Varsayilan_Printer
End Sub
 
Merhaba Korhan Bey,ilginiz için çok teşekkür ederim.Kodu uyguladım,
ama "Private Sub Worksheet_Activate()" ve "Set Yazici = ActivePrinter" alanında hatalar verdi.Tekrar deneyeceğim umarım olur.siz uygulayıp ekleyebilirsenizde çok sevinirim.yazıcı adını ben değiştiririm.

iyi akşamlar.
 
Üstteki mesajımdaki koda küçük bir ekleme yaptım. Tekrar deneyiniz.
 
Merhaba Korhan Bey,
Aynı konu bana da çok lazım. Verdiğiniz kodu ekledim lakin 3 satırda YAZICI yazan kısımda hata alıyorum.
İyi çalışmalar dilerim.
Saygılarımla
 
Son düzenleme:
Korhan Bey,tekrar kontrol etme şansımız var mı?Gerçekten çok ihtiyacım var.

Tşkler.

iyi günler.
 
Alternatif kod:

Açıklama önce hangi yazıcıda yazdırmak istiyorsanız o yazıcıyı varsayılan yazıcı olarak atayın ve aşağıdaki kodu çalıştırın kod A1 hücresine yazıcının adını yazacaktır.

Kod: 
Sub yazıcıadi()
MsgBox Application.ActivePrinter
Cells(1, 1).Value = Application.ActivePrinter
End Sub


Daha sonra aşağıdaki kodun kırmız yerine A1 hücresindeki yazıcı adını yazın ve aşağıdaki kodu çalıştırın.

not:yazıcı adı bazen göründüğü gibi olmaya bilir onun için önce yazıcı adını bir defaya mahsus A1 hücresine yazdırıyoruz
Benim yazıcım yazıcılar klasöründe görünen adı (Lexmark T650) ama A1 hücresindeki adı aşağıdaki kırmızı yazı gibi


Kod: 
Sub yazdır()
Varsayilan_Printer = Application.ActivePrinter
adres = ActiveWindow.RangeSelection.Address
a = InStr(Trim(adres), ":")
If a = 0 Then MsgBox "yazdırılacak alan seçimi yapmadınız.": Exit Sub
a = MsgBox(" için İzin kağıdı Yazdırmak İstiyormusunuz..?", vbYesNo, "Uyarı")
If a = 6 Then
Application.ActivePrinter = "[COLOR=red]Ne00: üzerindeki Lexmark T650[/COLOR] "
Worksheets(ActiveSheet.Name).PageSetup.PrintArea = adres
Worksheets(ActiveSheet.Name).PrintOut Copies:=1, Collate:=True
End If
Application.ActivePrinter = Varsayilan_Printer
End Sub
 
Merhaba Halit Bey,
Teşekkür ederim elinize sağlık süper olmuş.linki tıkladığımda direk seçili yazıcıya gönderme şansımız olabilir mi?Yani,buton oluşturmadan direk ana sayfadan linki tıkladığımda yazıcıya gönderebilir miyiz?
Tşkler.

iyi günler.
 
orange4609' Alıntı:
Merhaba Halit Bey,
Teşekkür ederim elinize sağlık süper olmuş.linki tıkladığımda direk seçili yazıcıya gönderme şansımız olabilir mi?Yani,buton oluşturmadan direk ana sayfadan linki tıkladığımda yazıcıya gönderebilir miyiz?
Tşkler.

iyi günler.
Genişletmek için tıkla ...

kod:

Kod: 
Sub yazdır()

adres = ActiveWindow.RangeSelection.Address
a = InStr(Trim(adres), ":")
If a = 0 Then MsgBox "yazdırılacak alan seçimi yapmadınız.": Exit Sub
a = MsgBox(" için İzin kağıdı Yazdırmak İstiyormusunuz..?", vbYesNo, "Uyarı")
If a = 6 Then
Worksheets(ActiveSheet.Name).PageSetup.PrintArea = adres
Worksheets(ActiveSheet.Name).PrintOut Copies:=1, Collate:=True
End If

End Sub
 
Halit Bey,
ana sayfadan linki tıkladığımda veri sayfasındaki seçili alanı buluyor ama belirtilen yazıcıya direkt göndermiyor.Kusura bakmayın sizi fazlasıyla meşğul ettim ama yazıcı yoluna(Ne03: üzerindeki \\B0484\TEC B-SA4G)göre direk gönderebilirseniz sevinirim.

Tşkler.

iyi günler.
 
Merhaba Halit Bey,
Aşağıdaki yapmış olduğunuz makro çalışıyor ama sadece düğmeyle çalışıyor.Düğme olmadan direk ana sayfadaki linki tıkladımızda (köprüyle alanı seçiyor zaten)yazıcıya gönderemez miyiz?zamanınız olursa bakabilirseniz sevinirim.

tşkler.

iyi günler.


Sub yazdır()
Varsayilan_Printer = Application.ActivePrinter
adres = ActiveWindow.RangeSelection.Address
a = InStr(Trim(adres), ":")
If a = 0 Then MsgBox "yazdırılacak alan seçimi yapmadınız.": Exit Sub
a = MsgBox(" için İzin kağıdı Yazdırmak İstiyormusunuz..?", vbYesNo, "Uyarı")
If a = 6 Then
Application.ActivePrinter = "Ne00: üzerindeki Lexmark T650 "
Worksheets(ActiveSheet.Name).PageSetup.PrintArea = adres
Worksheets(ActiveSheet.Name).PrintOut Copies:=1, Collate:=True
End If
Application.ActivePrinter = Varsayilan_Printer
End Sub
 
Merhaba,

Halit beyin önerdiği kodları biraz derleyerek #2 nolu mesajımdaki kodu güncelledim. Denermisiniz.
 
Merhaba Korhan Bey&Halit Bey,
ilgi ve alakanız için sonsuz teşekkürler,elinize sağlık,süper oldu.
sygılar,
iyi günler
 
Merhaba Korhan bey&Halit Bey,
copya sayısını(kaç adet yazdırmamız gerektiğini) sormasını nasıl sağlarız.
tşkler.
iyi günler


Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
Varsayilan_Printer = Application.ActivePrinter
Adres = ActiveWindow.RangeSelection.Address
If InStr(Trim(Adres), ":") = 0 Then MsgBox "Yazdırılacak alan seçimi yapmadınız!": Exit Sub
Onay = MsgBox("Kazım Yazdırma işlemine devam etmek istiyor musunuz?", vbYesNo, "Uyarı")
If Onay = vbYes Then
Application.ActivePrinter = "Ne03: üzerindeki \\B0484\TEC B-SA4G "
Worksheets(ActiveSheet.Name).PageSetup.PrintArea = Adres
Worksheets(ActiveSheet.Name).PrintOut Copies:=1, Collate:=True
End If
Application.ActivePrinter = Varsayilan_Printer
End Sub
 
kod:

Kod: 
Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
Varsayilan_Printer = Application.ActivePrinter
Adres = ActiveWindow.RangeSelection.Address
If InStr(Trim(Adres), ":") = 0 Then MsgBox "Yazdırılacak alan seçimi yapmadınız!": Exit Sub
Onay = MsgBox("Kazım Yazdırma işlemine devam etmek istiyor musunuz?", vbYesNo, "Uyarı")
If Onay = vbYes Then
[COLOR=red]adet = Application.InputBox("Kaç adet yazılacak.", "Yazdırma sayısı", "1", 400, 30, , Type:=1)
If adet = False Then
MsgBox "İşlemi iptal ettiniz"
Exit Sub
End If[/COLOR]
Application.ActivePrinter = "Ne03: üzerindeki [URL="file://\\B0484\TEC"]\\B0484\TEC[/URL] B-SA4G "
Worksheets(ActiveSheet.Name).PageSetup.PrintArea = Adres
Worksheets(ActiveSheet.Name).PrintOut Copies:=[COLOR=red]adet[/COLOR], Collate:=True
End If
Application.ActivePrinter = Varsayilan_Printer
End Sub
 
süpersiniz çok tşkler.
iyi günler
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst