Yazıcı Sonundaki Kod Hatası

[Nikolayco]

Selamlar, aşağıdaki gibi bir macro var. Kullanıyorum da fakat NE:** olan kısımlar sürekli değişiyor. el ile değiştirip tekrar tekrar kontrol etmem gerekiyor. tam kodu da bulamıyorum. tek tek deniyorum buna bir çözüm bulabilir miyim?

Sub BarkodYazdır()
'
' BarkodYazdır Macro
'
' Keyboard Shortcut: Ctrl+q
'
    Range("B23:AQ30").Select
    Application.ActivePrinter = "\\HALMEM03.pbgtr\Zebra  S600 on Ne04:"
    ExecuteExcel4Macro "PRINT(2,1,1,1,,,,,,,,2,,,TRUE,,FALSE)"
    Application.ActivePrinter = "\\halnet1\SEFAKOYMEM3035MFP on Ne02:"

End Sub
Sub SeriYazdir()
'
' SeriYazdir Macro
'
' Keyboard Shortcut: Ctrl+w
'
    Range("B23:AQ30").Select
    Application.ActivePrinter = "\\HALMEM03.pbgtr\Zebra  S600 on Ne04:"
    ExecuteExcel4Macro "PRINT(2,2,2,1,,,,,,,,2,,,TRUE,,FALSE)"
    Application.ActivePrinter = "\\halnet1\SEFAKOYMEM3035MFP on Ne02:"
End Sub
Sub BarkodSeriYazdir()
'
' BarkodSeriYazdir Macro
'
' Keyboard Shortcut: Ctrl+e
'
    Range("B23:AQ30").Select
    Application.ActivePrinter = "\\\HALMEM03.pbgtr\Zebra  S600 on Ne04:"
    ExecuteExcel4Macro "PRINT(2,1,2,1,,,,,,,,2,,,TRUE,,FALSE)"
    Application.ActivePrinter = "\\halnet1\SEFAKOYMEM3035MFP on Ne02:"
End Sub

 

[uzmanamele]

merhaba

bu şekilde deneyiniz.

Application.ActivePrinter = "\\HALMEM03.pbgtr\Zebra  S600 on Ne04:"

Application.ActivePrinter = "\\HALMEM03.pbgtr\Zebra  S600 on Ne"&range("a1")&":""

 

[Nikolayco]

Olmadı, malesef. Hata verdi. A1 e birşey mi yazmam gerekiyor tam olarak anlayamadım orasını.

 

[uzmanamele]

Olmadı, malesef. Hata verdi. A1 e birşey mi yazmam gerekiyor tam olarak anlayamadım orasını.

merhaba
A1 hücreye NE:** için yazmanız gereken 02 veya 04 gibi değeri yazarak deneyiniz.
bu seçimi veri doğrulama listesinden yapabileceğiniz gibi listbox ile de yapabilirsiniz.

kodları test etme şansımız yok, deneme yanılma ile sorunu çözmeye çalışıyoruz.

 

[Nikolayco]

merhaba
A1 hücreye NE:** için yazmanız gereken 02 veya 04 gibi değeri yazarak deneyiniz.
bu seçimi veri doğrulama listesinden yapabileceğiniz gibi listbox ile de yapabilirsiniz.

kodları test etme şansımız yok, deneme yanılma ile sorunu çözmeye çalışıyoruz.

Deniğiniz gibi denedim fakat olmadı.

Yanlış anlaşıldıysam özür, kırmak istemedim kimseyi.

Yalnız bende sorunuma çözüm bulmaya çalışıyorum.

Tşk.

 

[mancubus]

aşağıdaki gibi deneyin

Sub BarkodYazdır()

    Dim sActPrt as String
    sActPrt = Application.ActivePrinter

    Range("B23:AQ30").Select
    [COLOR="Red"]Application.ActivePrinter = sActPrt[/COLOR]
    ExecuteExcel4Macro "PRINT(2,1,1,1,,,,,,,,2,,,TRUE,,FALSE)"

End Sub

 

[Nikolayco]

Malesef olmadı. Default printer dan basıyor. Ben Zebradan basmasını daha sonra da işlem tamamlanında tekrar yazıcıyı sefakoymem e çevirmesini istiyorum.

tşk.

 

[mancubus]

Malesef olmadı. Default printer dan basıyor. Ben Zebradan basmasını daha sonra da işlem tamamlanında tekrar yazıcıyı sefakoymem e çevirmesini istiyorum.

tşk.

ilk mesajınızdaki problem değişen printer port numaraları ile ilgiliydi. benim önerim de port no ile ilgilenmeyi ortadan kaldırıyordu.

tabii şimdi farklı olduğunu anlıyorum. biraz google araması sonucunda bulduğum fonksiyon ile aşağıdaki gibi çözüm ürettim. evdeki printer'ım için problem çıkmadı. server için kodu test edip sonucu siz söyleyeceksiniz.

Sub BarkodYazdır()
    
Dim sDefPrt As String, sPrt As String
    
sPrt = "\\HALMEM03.pbgtr\Zebra S600"
sPrt = FindPrinter(prt)

Range("B23:AQ30").Select
Application.ActivePrinter = sPrt
ExecuteExcel4Macro "PRINT(2,1,1,1,,,,,,,,2,,,TRUE,,FALSE)"

sDefPrt = "\\halnet1\SEFAKOYMEM3035MFP"
sDefPrt = FindPrinter(sDefPrt)
Application.ActivePrinter = sDefPrt

End Sub





Function FindPrinter(ByVal PrinterName As String) As String

Dim Arr As Variant
Dim Device As Variant
Dim Devices As Variant
Dim Printer As String
Dim RegObj As Object
Dim RegValue As String
Const HKEY_CURRENT_USER = &H80000001
     
Set RegObj = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
RegObj.enumvalues HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Devices", Devices, Arr

For Each Device In Devices
    RegObj.getstringvalue HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Devices", Device, RegValue
    Printer = Device & " on " & Split(RegValue, ",")(1)
    If InStr(1, Printer, PrinterName, vbTextCompare) > 0 Then
        FindPrinter = Printer
        Exit Function
    End If
Next
      
End Function

 

[Nikolayco]

malesef yine olmadı, kodlarda hiç adı geçmeyen bir yazıcıdan çıktı almaya çalışıyor bu seferde..

 

[mancubus]

fonksiyonla birlikte aşağıdaki kodu çalıştırdığınızda mesaj kutusuna hangi printer'ın ismi geliyor.

Sub ActPrtTest()
    
Dim sPrt As String

sPrt = "\\HALMEM03.pbgtr\Zebra S600"
sPrt = FindPrinter(prt)

MsgBox sPrt

End Sub

 

[Nikolayco]

PDFCreator on NE:00 yazıcı ismi geliyor.

Daha önce de bununla yazmaya çalışıyordu zaten. Tşk.

 

[mancubus]

bir de şunu deneyin.

Sub BarkodYazdır()
    
Dim sCurPrt As String, sNetPrt As String

sCurPrt = Application.ActivePrinter 'mevcut yazıcı değişkene
sNetPrt = GetFullNetworkPrinterName("\\HALMEM03.pbgtr\Zebra S600")

If Len(sNetPrt) > 0 Then 'network yazıcısı bulundu
    Application.ActivePrinter = sNetPrt 'network yazıcısı aktif
    Range("B23:AQ30").Select
    ExecuteExcel4Macro "PRINT(2,1,1,1,,,,,,,,2,,,TRUE,,FALSE)"
    Application.ActivePrinter = sCurPrt 'mevcut yazıcıya geri dön
End If

End Sub





Function GetFullNetworkPrinterName(strNetworkPrinterName As String) As String
'http://forums.techarena.in/software-development/1140584.htm

Dim strCurrentPrinterName As String, strTempPrinterName As String, i As Long
strCurrentPrinterName = Application.ActivePrinter
i = 0
Do While i < 100
    strTempPrinterName = strNetworkPrinterName & " on Ne" & Format(i, "00") & ":"
    On Error Resume Next
    Application.ActivePrinter = strTempPrinterName
    On Error GoTo 0
    If Application.ActivePrinter = strTempPrinterName Then
        GetFullNetworkPrinterName = strTempPrinterName
        i = 100
    End If
    i = i + 1
Loop

End Function

 

[Nikolayco]

Bu sefer de hiç bir işlem yapmıyor. Yani butona tıklıyorum işlem yapıyormuş gibi hiç hata vermiyor, yalnız işlemi de yapmıyor. Yardım lütfen..

 

[mancubus]

24 gün sonra problem belirtmişsiniz.

tesadüf dosya duruyormuş.
12 no.lu mesajdaki çözüm benim için sorunsuz çalışıyordu.
hala çalışıyor.

 

[Nikolayco]

Yurtdışındaydım konu ile ilgilenemedim bu yüzden..

Dosyamı ekliyorum ek e.. ilgilenebilirmisiniz lütfen. tşk.

 

[mancubus]

öncelikle Barkod Basımı sayfasındaki kodları silin. kullanıcı tanımlı fonksiyonlar standart modüllerde yer alır. (oraya da almışsınız zaten. OK.)

farklı işlev göstermeyecek olmakla birlikte mevcut kodu aşağıdaki şekilde revize edelim.

Sub BarkodYazdır()
    
Dim sCurPrt As String, sNetPrt As String

sCurPrt = Application.ActivePrinter 'mevcut yazıcı değişkene
sNetPrt = GetFullNetworkPrinterName("\\HALMEM03.pbgtr\Zebra S600")

If Len(sNetPrt) > 0 Then 'network yazıcısı bulundu
    Application.ActivePrinter = sNetPrt 'network yazıcısı aktif
End If
    
Range("B23:AQ30").Select
ExecuteExcel4Macro "PRINT(2,1,1,1,,,,,,,,2,,,TRUE,,FALSE)"
    
Application.ActivePrinter = sCurPrt 'mevcut yazıcıya geri dön

End Sub

ilk önce kullanmayı düşündüğümüz yazıcılar tanımlı mı görelim ve aktif yazıcı bizim istediğimiz yazıcı mı test edelim: (tamam tıklandıktan sonra açılan kutuda aktif yazıcının isminin çıkması lazım.)

Sub yazici_sec()

Dim CurPrt

CurPrt = Application.Dialogs(xlDialogPrinterSetup).Show
If CurPrt = False Then Exit Sub
MsgBox ActivePrinter

End Sub

ikinci olarak aşağıdaki makro ile yazıcı isimlerinin istediğimiz şekilde değişip değişmediğini test edelim. printer isimleri mesaj kutusunda çıkacaktır. kutulara tamam tıklayarak devam edelim.

Sub Printer_Test()

Dim sCurPrt As String, sNetPrt As String

sCurPrt = Application.ActivePrinter 'mevcut yazıcı değişkene
        MsgBox "1 Mevcut yazıcı: " & sCurPrt

sNetPrt = GetFullNetworkPrinterName("\\HALMEM03.pbgtr\Zebra S600")

If Len(sNetPrt) > 0 Then 'network yazıcısı bulundu
    Application.ActivePrinter = sNetPrt 'network yazıcısı aktif
        MsgBox "2 Yeni yazıcı: " & sNetPrt
End If

Application.ActivePrinter = sCurPrt 'mevcut yazıcıya geri dön
        MsgBox "3 mevcut yazıcı: " & sCurPrt

End Sub

eğer sorun çıkmıyorsa ok.
çıkıyorsa varsa şirket içinden bir uzmandan destek alın.

dediğim gibi, ben kodları bizim network'te test ettim, yazıcı isimleri farklı olmak üzere elbette, sorun çıkmadı.

 

[Nikolayco]

Seçilen yazıcıdan baıyor fakat default yazıcıya geri dönmüyor.

Yani, Barkod yazdır dediğimde default yazıcı hangisiyse ondan basıyor. manuel olarak yazıcıyı seçiyorum isteidğim yazıcıdan basıyor. sonra normal default yazıcıya dönmesi gerekirken dönmüyor.

 

[mancubus]

şu son mesajdan anlıyorum ki, benim "acaba farklı bir husus var mıdır" diye yaptığım google taramaları ile birlikte 1 saatten fazla zamanımı alan kodları denememişsiniz.

ilk mesajınızı tekrar etmişsiniz.

ben normalde kullanamadığımız network yazıcılarını da rica minnet geçici olarak kendime tanımlatıp denedim, en küçük bir problem çıkmadı.

bundan sonra önerbileceğim bir husus bulunmamaktadır.

sağlıcakla.

 

[Nikolayco]

şu son mesajdan anlıyorum ki, benim "acaba farklı bir husus var mıdır" diye yaptığım google taramaları ile birlikte 1 saatten fazla zamanımı alan kodları denememişsiniz.

ilk mesajınızı tekrar etmişsiniz.

ben normalde kullanamadığımız network yazıcılarını da rica minnet geçici olarak kendime tanımlatıp denedim, en küçük bir problem çıkmadı.

bundan sonra önerbileceğim bir husus bulunmamaktadır.

sağlıcakla.

Sizi kırmak yada kızdırmak istememiştim. Yapmak istediğim bir hedef var ve macro konusundan anlamıyorum malesef. Bu yüzden bu forum aracılığı ile yardım alarak hedefime ulaşmaya çalışıyorum zaten.

Kusura bakmayın tekrar. Yardımlarınız içinde çok teşekkür ederim.