TEC printer etiket yazdırma sorunu

Katılım
28 Nisan 2005
Mesajlar
252
Excel Vers. ve Dili
Excel 2010 Türkçe
Merhaba Arkadaşlar

Excelde hazırladığım bir uygulamada etiket print etmem gerekiyor. Etiket makinesi olarak TEC 482 printer var. Etiketi printere gönderiyorum ama yazdırmadan önce bazı özelliklerini değiştirmem gerekiyor.
Ã?rneğin etiket tipini seçmem lazım ve Print method da default olarak Direct Thermal" seçeneği geliyor. Ben onu her seferinde "Termal transfer olarak seçmen gerekiyor.
Bu işlemi kod ile yap şansımız varmı? Her seferinde manuel olarak seçmek çoğu zaman hata yapmamamıza neden oluyor.

Yardımlarınızı bekliyorum. :kafa:
 

Levent Menteşoğlu

Administrator
Yönetici
Admin
Katılım
13 Ekim 2004
Mesajlar
16,057
Excel Vers. ve Dili
Excel 2010-32 bit-Türkçe
Excel 365 -32 bit-Türkçe
İlginç, benimde başımın belası bir TEC B-442 var, onda ayarları bir kez yapınca değiştirmeye gerek kalmıyor. Makro kaydet yöntemi ile deneyin.
 
Katılım
28 Nisan 2005
Mesajlar
252
Excel Vers. ve Dili
Excel 2010 Türkçe
Makro kaydeti denedim ama sadece copy sayısını kodluyor. diğer printere ait özellikler ile ilgili yapılan değişiklikleri kaydetmedi.
Napalım bizde manuel yapcaz artık.

teşekkürler
 
Katılım
28 Nisan 2005
Mesajlar
252
Excel Vers. ve Dili
Excel 2010 Türkçe
Merhaba Leventm

Aşağıdaki kod ile etiket yazdırıyorum. Print preview'le yazıcı özelliklerini ayarlayıp ilk etiketi burdan alıyorum. Kod yardımı ilede diğer birbirinden farklı etiketlerin print edilmesini sağlıyorum. Print preview aşamasında işlemden vazgeçip "CLOSE" butonuna bastığım zaman yazdırma işleminin iptal edildiğine dair bir mesaj vermesini arkasından yazdırma işlemini durdurmasını istiyorum.
Mümkün mü?
Teşekkürler
Kod:
Private Sub CommandButton6_Click()
Application.ScreenUpdating = False
Application.Visible = True
If ComboBox1 = epmty Or TextBox3 = Empty Or TextBox30 = Empty Or TextBox31 = Empty Then
    MsgBox "Lütfen boşlukları doldurunuz.", vbExclamation, "UYARI"
    Exit Sub
End If
.
.
.
UserForm1.Hide
If CheckBox1 = True Then
    Sheets("TEC").[C10] = 1
    Sheets("Bakanlık").PrintPreview
    For i = 2 To 5
        Sheets("TEC").[C10] = i
        Sheets("bakanlık").PrintOut Copies:=1
    Next i
End If
If CheckBox2 = True Or CheckBox6 = True Then
If TextBox5 = Empty Then
    If Sheets("TEC").[B12] <> "" Then
        If Sheets("TEC").[B12] > 25 Then
            Sheets("TEC").[C12] = 1
            Sheets("Raf").PrintPreview
            Sheets("TEC").[C12] = Delete
            GoTo raf1
        End If
        Sheets("TEC").[C12] = 1
        Sheets("Raf").PrintPreview
        For i = 2 To TextBox6
            Sheets("TEC").[C12] = i
            Sheets("Raf").PrintOut Copies:=1
        Next i
        Sheets("TEC").[C12] = Delete
    End If
raf1:
    If Sheets("TEC").[B13] <> "" Then
        If Sheets("TEC").[B13] > 25 Then
            Sheets("TEC").[C13] = 1
            Sheets("Raf").PrintOut Copies:=1
            Sheets("TEC").[C13] = Delete
            GoTo raf2
        End If
        For i = 1 To TextBox7
            Sheets("TEC").[C13] = i
            Sheets("Raf").PrintOut Copies:=1
        Next i
        Sheets("TEC").[C13] = Delete
    End If
raf2:
    If Sheets("TEC").[B14] <> "" Then
        If Sheets("TEC").[B14] > 25 Then
            Sheets("TEC").[C14] = 1
            Sheets("Raf").PrintOut Copies:=1
            Sheets("TEC").[C14] = Delete
            GoTo raf3
        End If
        For i = 1 To TextBox8
            Sheets("TEC").[C14] = i
            Sheets("Raf").PrintOut Copies:=1
        Next i
        Sheets("TEC").[C14] = Delete
    End If
Else
    Sheets("Raf").PrintPreview
If TextBox31.Value * 1 > 1 Then
    Sheets("Raf").PrintOut Copies:=TextBox31.Value * 1 - 1
End If
End If
raf3:
End If
If CheckBox3 = True Then
    Sheets("TEC").Cells(23, 3) = 1
    Sheets("Mikr").PrintPreview
    Sheets("TEC").Cells(23, 3) = Delete
        For i = 24 To 26
            Sheets("TEC").Cells(i, 3) = 1
            Sheets("Mikr").PrintOut Copies:=1
            Sheets("TEC").Cells(i, 3) = Delete
        Next i
End If
If CheckBox4 = True Then
    If TextBox14 = Empty Then
        Sheets("TEC").Cells(15, 3) = 1
        Sheets("Test").PrintPreview
        Sheets("TEC").Cells(15, 3) = Delete
            For i = 16 To 18
                Sheets("TEC").Cells(i, 3) = 1
                Sheets("Test").PrintOut Copies:=1
                Sheets("TEC").Cells(i, 3) = Delete
            Next i
    Else
        Sheets("Test").PrintPreview
        If TextBox31.Value * 1 > 1 Then
            Sheets("Test").PrintOut Copies:=TextBox31.Value * 1 - 1
        End If
    End If
End If
If CheckBox5 = True Then
    If TextBox14 = Empty Then
        Sheets("TEC").Cells(19, 3) = 1
        Sheets("TestR").PrintPreview
        Sheets("TEC").Cells(19, 3) = Delete
            For i = 20 To 22
                Sheets("TEC").Cells(i, 3) = 1
                Sheets("TestR").PrintOut Copies:=1
                Sheets("TEC").Cells(i, 3) = Delete
            Next i
    Else
        Sheets("TestR").PrintPreview
        If TextBox31.Value * 1 > 1 Then
            Sheets("Test").PrintOut Copies:=TextBox31.Value * 1 - 1
        End If
    End If
End If

For i = 1 To 28
Sheets("TEC").Cells(i, 2) = Delete
Next i
Application.Visible = False
UserForm1.Show
End Sub
 

Levent Menteşoğlu

Administrator
Yönetici
Admin
Katılım
13 Ekim 2004
Mesajlar
16,057
Excel Vers. ve Dili
Excel 2010-32 bit-Türkçe
Excel 365 -32 bit-Türkçe
Printpreview konumundan çıkınca yazdırma işlemi yapmasını istemiyorsanız, kod içinde farklı bir mantık kurmanız gerekiyor. Ã?rneğin bir msgbox ile yazdırmaya devam etmek istiyormusunuz diye sordurabilirsiniz.

[vb:1:d2c155e1d6]Sheets("Bakanlık").PrintPreview
sor = MsgBox("YAZDIRMAK İSTİYORMUSUNUZ", vbYesNo)
If sor = vbNo Then Exit Sub
.
.Kodlarınızın devamı
.[/vb:1:d2c155e1d6]
 
Üst