Uzak Masaüstünde kullanılan bir excelde varsayılan yazıcı harici yazıcı seçimi

Soundcraft

Soundcraft

Altın Üye
Katılım
29 Aralık 2005
Mesajlar
33
Excel Vers. ve Dili
Office 2016 TR 64 Bit
Altın Üyelik Bitiş Tarihi
05-08-2026
Herkese merhabalar.

Kullanmış olduğum işyeri dosyaları uzak masaüstü ile bağlanarak işlem yaptığım bir sunucu üzerinde.

Yine bu sunucu üzerinde kullandığım bir excel dosyam var ancak bu dosadaki sayfayı yazdırdığımda (buton ile fiş baskısı) çıktıları kendi bilgisayarımdaki noktavuruşlu bir yazıcıdan almam gerekiyor.

Kod: 
y.Range("A1:F" & x + 31).PrintOut Copies:=1, ActivePrinter:="TS009: OKI ML3320 TR (2 yönlendirildi) ", Collate:=True
Kullandığım kod bu.Kendi bilgisayarımda bu kod çalışıyor ancak uzak masaüstünde kod çalışmıyor yine varsayılan yazıcıdan çıktı alıyor anlam veremedim.

Elle yazdır dediğimde çıktı alabiliyorum ama sorun yok.

Konu hakkında bilgisi olan varsa yardımcı olabilirseni çok sevinirim.

Saygı ve muhabbetlerimle.
 
Z

zehirlee

Katılım
15 Aralık 2017
Mesajlar
105
Excel Vers. ve Dili
Microsoft Office Ev ve İş 2013 - 32 bit
Altın Üyelik Bitiş Tarihi
21/12/2022
bu kodu mevcut makroyu değiştirerek uygulayıp deneyiniz.

Sub PrintWithPrinterSelection()
Dim PrinterDialog As Object
Dim SelectedPrinter As String

' Yazıcı seçim kutusunu oluştur
Set PrinterDialog = Application.Dialogs(xlDialogPrinterSetup)

' Kullanıcıdan yazıcı seçimini iste
If PrinterDialog.Show = -1 Then
SelectedPrinter = PrinterDialog.DeviceName
Else
MsgBox "Yazıcı seçilmediği için işlem iptal edildi."
Exit Sub
End If

' Seçilen yazıcıya belgeyi yazdır
ThisWorkbook.Sheets("Sayfa1").Range("A1:F" & x + 31).PrintOut Copies:=1, Collate:=True, ActivePrinter:=SelectedPrinter
End Sub
 
M

muhasebeciyiz

Altın Üye
Katılım
10 Şubat 2006
Mesajlar
568
Excel Vers. ve Dili
Office 2016
64 Bit
Altın Üyelik Bitiş Tarihi
21-12-2027
1. Yazıcı Yönlendirme:
Uzak masaüstü bağlantısı yaparken Seçenekler penceresinde Yerel Kaynaklar sekmesine gidin.
Yazıcılar seçeneğinin altında Yazıcıları bağla seçeneğini işaretleyin.
Uygula ve Tamam butonlarına tıklayın.

2. Yazıcı Seçimi:
Excel dosyanızdaki VBA kodunda yazıcıyı seçerken ActivePrinter yerine yazıcınızın tam adını kullanın.

Örnek kod:
y.Range("A1:F" & x + 31).PrintOut Copies:=1, Printer:="TS009: OKI ML3320 TR (2 yönlendirildi) ", Collate:=True
 
cavanoos

cavanoos

Altın Üye
Katılım
17 Aralık 2008
Mesajlar
727
Excel Vers. ve Dili
Microsoft 365
Altın Üyelik Bitiş Tarihi
11-01-2026
zehirlee' Alıntı:
bu kodu mevcut makroyu değiştirerek uygulayıp deneyiniz.

Sub PrintWithPrinterSelection()
Dim PrinterDialog As Object
Dim SelectedPrinter As String

' Yazıcı seçim kutusunu oluştur
Set PrinterDialog = Application.Dialogs(xlDialogPrinterSetup)

' Kullanıcıdan yazıcı seçimini iste
If PrinterDialog.Show = -1 Then
SelectedPrinter = PrinterDialog.DeviceName
Else
MsgBox "Yazıcı seçilmediği için işlem iptal edildi."
Exit Sub
End If

' Seçilen yazıcıya belgeyi yazdır
ThisWorkbook.Sheets("Sayfa1").Range("A1:F" & x + 31).PrintOut Copies:=1, Collate:=True, ActivePrinter:=SelectedPrinter
End Sub
Genişletmek için tıkla ...


Kodunuzu denedim. Aşağıdaki satırda hata verdi.
SelectedPrinter = PrinterDialog.DeviceName
 
Soundcraft

Soundcraft

Altın Üye
Katılım
29 Aralık 2005
Mesajlar
33
Excel Vers. ve Dili
Office 2016 TR 64 Bit
Altın Üyelik Bitiş Tarihi
05-08-2026
muhasebeciyiz' Alıntı:
1. Yazıcı Yönlendirme:
Uzak masaüstü bağlantısı yaparken Seçenekler penceresinde Yerel Kaynaklar sekmesine gidin.
Yazıcılar seçeneğinin altında Yazıcıları bağla seçeneğini işaretleyin.
Uygula ve Tamam butonlarına tıklayın.

2. Yazıcı Seçimi:
Excel dosyanızdaki VBA kodunda yazıcıyı seçerken ActivePrinter yerine yazıcınızın tam adını kullanın.

Örnek kod:
y.Range("A1:F" & x + 31).PrintOut Copies:=1, Printer:="TS009: OKI ML3320 TR (2 yönlendirildi) ", Collate:=True
Genişletmek için tıkla ...
Hocam,
1. yazıcı yönlendirmesinde sorun yok tekrar kontrol ettim. uzak masaüstünde elle yazdır dediğimizde de sorunsuz yazdırıyor zaten
2. Kod hata veriyor
 
Soundcraft

Soundcraft

Altın Üye
Katılım
29 Aralık 2005
Mesajlar
33
Excel Vers. ve Dili
Office 2016 TR 64 Bit
Altın Üyelik Bitiş Tarihi
05-08-2026
zehirlee' Alıntı:
bu kodu mevcut makroyu değiştirerek uygulayıp deneyiniz.

Sub PrintWithPrinterSelection()
Dim PrinterDialog As Object
Dim SelectedPrinter As String

' Yazıcı seçim kutusunu oluştur
Set PrinterDialog = Application.Dialogs(xlDialogPrinterSetup)

' Kullanıcıdan yazıcı seçimini iste
If PrinterDialog.Show = -1 Then
SelectedPrinter = PrinterDialog.DeviceName
Else
MsgBox "Yazıcı seçilmediği için işlem iptal edildi."
Exit Sub
End If

' Seçilen yazıcıya belgeyi yazdır
ThisWorkbook.Sheets("Sayfa1").Range("A1:F" & x + 31).PrintOut Copies:=1, Collate:=True, ActivePrinter:=SelectedPrinter
End Sub
Genişletmek için tıkla ...
Bu kodu uygulayamadım bende de hata verdi.

Makronun tamamı şu şekilde.

Kod: 
Sub Fiş_Yazdır()
Set y = Sheets("Yazdır")
y.Range("A3:F50") = ""
y.Range("A5:F50").UnMerge
y.Range("A3:F500").Borders.LineStyle = 0
y.Range("A3:F50").Font.Bold = False
y.Range("A3:F50").Font.Size = 8
y.Range("A3:F50").RowHeight = 17
y.Range("A3:F50").VerticalAlignment = xlBottom
y.Range("A3:F50").WrapText = True
y.Rows("6:160").AutoFit
y.Range("A5:F5").Font.Bold = True
y.Range("A3") = "TARİH  : " & Format(Date, "dd.mm.yyyy")
y.Range("C3") = "FİŞ NO : " & Format(Range("AA2"), "0000")
y.Range("A5") = "ÜRÜN ADI"
y.Range("B5") = "KAS.NO"
y.Range("C5") = "NOT"
y.Range("D5") = "AD./KG"
y.Range("E5") = "FİYAT"
y.Range("F5") = "TUTAR"
y.Range("A5:F5").Borders(xlEdgeBottom).LineStyle = 1
x = WorksheetFunction.CountA(Range("A7:A28")) + 6

For i = 7 To x

y.Cells(i + -1, 1) = Cells(i, 1).Value
y.Cells(i + -1, 2) = Cells(i, 3).Value
y.Cells(i + -1, 3) = Cells(i, 4).Value
y.Cells(i + -1, 4) = Cells(i, 5).Value
y.Cells(i + -1, 5) = Cells(i, 6).Value
y.Cells(i + -1, 6) = Cells(i, 7).Value

Next

y.Range("A" & x + 1 & ":F" & x + 1).Borders(xlEdgeTop).LineStyle = 2
y.Range("A" & x + 1 & ":F" & x + 1).Borders(xlEdgeBottom).LineStyle = 2
y.Range("A" & x + 1) = "TOPLAM"
y.Range("E" & x + 1 & ":F" & x + 1).Merge
y.Range("E" & x + 1).NumberFormat = "#,##0.00 $"
y.Range("E" & x + 1) = WorksheetFunction.Sum(Range("G7:G30"))
y.Range("E" & x + 1).HorizontalAlignment = xlRight

y.Range("A" & x + 1 & ":F" & x + 1).Font.Bold = True
y.Range("A" & x + 1 & ":F" & x + 1).Font.Size = 8
y.Range("A" & x + 3 & ":F" & x + 3).Merge
y.Range("A" & x + 3).HorizontalAlignment = xlLeft
y.Range("A" & x + 3) = "BİLGİ AMAÇLIDIR. MALİ DEĞERİ YOKTUR."
y.Range("A" & x + 4 & ":F" & x + 4).Merge
y.Range("A" & x + 4).HorizontalAlignment = xlLeft
y.Range("A" & x + 4) = " "
x = y.Cells(Rows.Count, 2).End(3).Row
y.Range("A1:F" & x + 31).PrintOut Copies:=1, ActivePrinter:="TS009: OKI ML3320 TR (2 yönlendirildi) ", Collate:=True

Set y = Nothing

End Sub
 
Z

zehirlee

Katılım
15 Aralık 2017
Mesajlar
105
Excel Vers. ve Dili
Microsoft Office Ev ve İş 2013 - 32 bit
Altın Üyelik Bitiş Tarihi
21/12/2022
Soundcraft' Alıntı:
Bu kodu uygulayamadım bende de hata verdi.

Makronun tamamı şu şekilde.

Kod: 
Sub Fiş_Yazdır()
Set y = Sheets("Yazdır")
y.Range("A3:F50") = ""
y.Range("A5:F50").UnMerge
y.Range("A3:F500").Borders.LineStyle = 0
y.Range("A3:F50").Font.Bold = False
y.Range("A3:F50").Font.Size = 8
y.Range("A3:F50").RowHeight = 17
y.Range("A3:F50").VerticalAlignment = xlBottom
y.Range("A3:F50").WrapText = True
y.Rows("6:160").AutoFit
y.Range("A5:F5").Font.Bold = True
y.Range("A3") = "TARİH  : " & Format(Date, "dd.mm.yyyy")
y.Range("C3") = "FİŞ NO : " & Format(Range("AA2"), "0000")
y.Range("A5") = "ÜRÜN ADI"
y.Range("B5") = "KAS.NO"
y.Range("C5") = "NOT"
y.Range("D5") = "AD./KG"
y.Range("E5") = "FİYAT"
y.Range("F5") = "TUTAR"
y.Range("A5:F5").Borders(xlEdgeBottom).LineStyle = 1
x = WorksheetFunction.CountA(Range("A7:A28")) + 6

For i = 7 To x

y.Cells(i + -1, 1) = Cells(i, 1).Value
y.Cells(i + -1, 2) = Cells(i, 3).Value
y.Cells(i + -1, 3) = Cells(i, 4).Value
y.Cells(i + -1, 4) = Cells(i, 5).Value
y.Cells(i + -1, 5) = Cells(i, 6).Value
y.Cells(i + -1, 6) = Cells(i, 7).Value

Next

y.Range("A" & x + 1 & ":F" & x + 1).Borders(xlEdgeTop).LineStyle = 2
y.Range("A" & x + 1 & ":F" & x + 1).Borders(xlEdgeBottom).LineStyle = 2
y.Range("A" & x + 1) = "TOPLAM"
y.Range("E" & x + 1 & ":F" & x + 1).Merge
y.Range("E" & x + 1).NumberFormat = "#,##0.00 $"
y.Range("E" & x + 1) = WorksheetFunction.Sum(Range("G7:G30"))
y.Range("E" & x + 1).HorizontalAlignment = xlRight

y.Range("A" & x + 1 & ":F" & x + 1).Font.Bold = True
y.Range("A" & x + 1 & ":F" & x + 1).Font.Size = 8
y.Range("A" & x + 3 & ":F" & x + 3).Merge
y.Range("A" & x + 3).HorizontalAlignment = xlLeft
y.Range("A" & x + 3) = "BİLGİ AMAÇLIDIR. MALİ DEĞERİ YOKTUR."
y.Range("A" & x + 4 & ":F" & x + 4).Merge
y.Range("A" & x + 4).HorizontalAlignment = xlLeft
y.Range("A" & x + 4) = " "
x = y.Cells(Rows.Count, 2).End(3).Row
y.Range("A1:F" & x + 31).PrintOut Copies:=1, ActivePrinter:="TS009: OKI ML3320 TR (2 yönlendirildi) ", Collate:=True

Set y = Nothing

End Sub
Genişletmek için tıkla ...

Bunu deneyiniz

Sub Fiş_Yazdır()
Dim y As Worksheet
Dim x As Long
Dim PrinterName As String

' Yazdırma işlemi için kullanılacak sayfayı belirle
Set y = Sheets("Yazdır")

' Belirli bir aralıktaki hücreleri temizle
y.Range("A3:F50").ClearContents

' Belirli bir aralıktaki hücrelerin birleşimini çöz
y.Range("A5:F50").UnMerge

' Belirli bir aralıktaki hücre sınırlarının çizgisini kaldır
y.Range("A3:F500").Borders.LineStyle = 0

' Belirli bir aralıktaki metin biçimini değiştir
y.Range("A3:F50").Font.Bold = False
y.Range("A3:F50").Font.Size = 8
y.Range("A3:F50").RowHeight = 17
y.Range("A3:F50").VerticalAlignment = xlBottom
y.Range("A3:F50").WrapText = True
y.Rows("6:160").AutoFit
y.Range("A5:F5").Font.Bold = True

' Tarih ve Fiş No bilgisini ekleyelim
y.Range("A3") = "TARİH : " & Format(Date, "dd.mm.yyyy")
y.Range("C3") = "FİŞ NO : " & Format(Range("AA2"), "0000")

' Başlık satırını ekleyelim
y.Range("A5") = "ÜRÜN ADI"
y.Range("B5") = "KAS.NO"
y.Range("C5") = "NOT"
y.Range("D5") = "AD./KG"
y.Range("E5") = "FİYAT"
y.Range("F5") = "TUTAR"
y.Range("A5:F5").Borders(xlEdgeBottom).LineStyle = 1

' Verileri kopyalayalım
x = WorksheetFunction.CountA(Range("A7:A28")) + 6
For i = 7 To x
y.Cells(i - 1, 1) = Cells(i, 1).Value
y.Cells(i - 1, 2) = Cells(i, 3).Value
y.Cells(i - 1, 3) = Cells(i, 4).Value
y.Cells(i - 1, 4) = Cells(i, 5).Value
y.Cells(i - 1, 5) = Cells(i, 6).Value
y.Cells(i - 1, 6) = Cells(i, 7).Value
Next i

' Toplam hücresini ayarla
y.Range("A" & x + 1 & ":F" & x + 1).Borders(xlEdgeTop).LineStyle = 2
y.Range("A" & x + 1 & ":F" & x + 1).Borders(xlEdgeBottom).LineStyle = 2
y.Range("A" & x + 1) = "TOPLAM"
y.Range("E" & x + 1 & ":F" & x + 1).Merge
y.Range("E" & x + 1).NumberFormat = "#,##0.00 $"
y.Range("E" & x + 1) = WorksheetFunction.Sum(Range("G7:G30"))
y.Range("E" & x + 1).HorizontalAlignment = xlRight

' Toplam hücresini biçimlendir
y.Range("A" & x + 1 & ":F" & x + 1).Font.Bold = True
y.Range("A" & x + 1 & ":F" & x + 1).Font.Size = 8

' Bilgilendirme satırlarını ekle
y.Range("A" & x + 3 & ":F" & x + 3).Merge
y.Range("A" & x + 3).HorizontalAlignment = xlLeft
y.Range("A" & x + 3) = "BİLGİ AMAÇLIDIR. MALİ DEĞERİ YOKTUR."
y.Range("A" & x + 4 & ":F" & x + 4).Merge
y.Range("A" & x + 4).HorizontalAlignment = xlLeft
y.Range("A" & x + 4) = " "

' Yazıcıyı seç
PrinterName = Application.Dialogs(xlDialogPrinterSetup).Show
If PrinterName <> "" Then
' Yazdır
x = y.Cells(Rows.Count, 2).End(xlUp).Row
y.Range("A1:F" & x + 31).PrintOut Copies:=1, ActivePrinter:=PrinterName, Collate:=True
Else
MsgBox "Yazıcı seçilmedi! İşlem iptal edildi."
End If

Set y = Nothing
End Sub
 
Soundcraft

Soundcraft

Altın Üye
Katılım
29 Aralık 2005
Mesajlar
33
Excel Vers. ve Dili
Office 2016 TR 64 Bit
Altın Üyelik Bitiş Tarihi
05-08-2026
zehirlee' Alıntı:
Bunu deneyiniz

Sub Fiş_Yazdır()
Dim y As Worksheet
Dim x As Long
Dim PrinterName As String

' Yazdırma işlemi için kullanılacak sayfayı belirle
Set y = Sheets("Yazdır")

' Belirli bir aralıktaki hücreleri temizle
y.Range("A3:F50").ClearContents

' Belirli bir aralıktaki hücrelerin birleşimini çöz
y.Range("A5:F50").UnMerge

' Belirli bir aralıktaki hücre sınırlarının çizgisini kaldır
y.Range("A3:F500").Borders.LineStyle = 0

' Belirli bir aralıktaki metin biçimini değiştir
y.Range("A3:F50").Font.Bold = False
y.Range("A3:F50").Font.Size = 8
y.Range("A3:F50").RowHeight = 17
y.Range("A3:F50").VerticalAlignment = xlBottom
y.Range("A3:F50").WrapText = True
y.Rows("6:160").AutoFit
y.Range("A5:F5").Font.Bold = True

' Tarih ve Fiş No bilgisini ekleyelim
y.Range("A3") = "TARİH : " & Format(Date, "dd.mm.yyyy")
y.Range("C3") = "FİŞ NO : " & Format(Range("AA2"), "0000")

' Başlık satırını ekleyelim
y.Range("A5") = "ÜRÜN ADI"
y.Range("B5") = "KAS.NO"
y.Range("C5") = "NOT"
y.Range("D5") = "AD./KG"
y.Range("E5") = "FİYAT"
y.Range("F5") = "TUTAR"
y.Range("A5:F5").Borders(xlEdgeBottom).LineStyle = 1

' Verileri kopyalayalım
x = WorksheetFunction.CountA(Range("A7:A28")) + 6
For i = 7 To x
y.Cells(i - 1, 1) = Cells(i, 1).Value
y.Cells(i - 1, 2) = Cells(i, 3).Value
y.Cells(i - 1, 3) = Cells(i, 4).Value
y.Cells(i - 1, 4) = Cells(i, 5).Value
y.Cells(i - 1, 5) = Cells(i, 6).Value
y.Cells(i - 1, 6) = Cells(i, 7).Value
Next i

' Toplam hücresini ayarla
y.Range("A" & x + 1 & ":F" & x + 1).Borders(xlEdgeTop).LineStyle = 2
y.Range("A" & x + 1 & ":F" & x + 1).Borders(xlEdgeBottom).LineStyle = 2
y.Range("A" & x + 1) = "TOPLAM"
y.Range("E" & x + 1 & ":F" & x + 1).Merge
y.Range("E" & x + 1).NumberFormat = "#,##0.00 $"
y.Range("E" & x + 1) = WorksheetFunction.Sum(Range("G7:G30"))
y.Range("E" & x + 1).HorizontalAlignment = xlRight

' Toplam hücresini biçimlendir
y.Range("A" & x + 1 & ":F" & x + 1).Font.Bold = True
y.Range("A" & x + 1 & ":F" & x + 1).Font.Size = 8

' Bilgilendirme satırlarını ekle
y.Range("A" & x + 3 & ":F" & x + 3).Merge
y.Range("A" & x + 3).HorizontalAlignment = xlLeft
y.Range("A" & x + 3) = "BİLGİ AMAÇLIDIR. MALİ DEĞERİ YOKTUR."
y.Range("A" & x + 4 & ":F" & x + 4).Merge
y.Range("A" & x + 4).HorizontalAlignment = xlLeft
y.Range("A" & x + 4) = " "

' Yazıcıyı seç
PrinterName = Application.Dialogs(xlDialogPrinterSetup).Show
If PrinterName <> "" Then
' Yazdır
x = y.Cells(Rows.Count, 2).End(xlUp).Row
y.Range("A1:F" & x + 31).PrintOut Copies:=1, ActivePrinter:=PrinterName, Collate:=True
Else
MsgBox "Yazıcı seçilmedi! İşlem iptal edildi."
End If

Set y = Nothing
End Sub
Genişletmek için tıkla ...

Teşekkür ederim Evet çalıştı. Butona bastığımızda yazıcı seçim ekranı geliyor. Oradan yazdır dediğimde yazdırıyor. Peki burada Yazıcıyı sabitleyemezmiyiz?
 
Soundcraft

Soundcraft

Altın Üye
Katılım
29 Aralık 2005
Mesajlar
33
Excel Vers. ve Dili
Office 2016 TR 64 Bit
Altın Üyelik Bitiş Tarihi
05-08-2026
zehirlee' Alıntı:
Bunu deneyiniz

Sub Fiş_Yazdır()
Dim y As Worksheet
Dim x As Long
Dim PrinterName As String

' Yazdırma işlemi için kullanılacak sayfayı belirle
Set y = Sheets("Yazdır")

' Belirli bir aralıktaki hücreleri temizle
y.Range("A3:F50").ClearContents

' Belirli bir aralıktaki hücrelerin birleşimini çöz
y.Range("A5:F50").UnMerge

' Belirli bir aralıktaki hücre sınırlarının çizgisini kaldır
y.Range("A3:F500").Borders.LineStyle = 0

' Belirli bir aralıktaki metin biçimini değiştir
y.Range("A3:F50").Font.Bold = False
y.Range("A3:F50").Font.Size = 8
y.Range("A3:F50").RowHeight = 17
y.Range("A3:F50").VerticalAlignment = xlBottom
y.Range("A3:F50").WrapText = True
y.Rows("6:160").AutoFit
y.Range("A5:F5").Font.Bold = True

' Tarih ve Fiş No bilgisini ekleyelim
y.Range("A3") = "TARİH : " & Format(Date, "dd.mm.yyyy")
y.Range("C3") = "FİŞ NO : " & Format(Range("AA2"), "0000")

' Başlık satırını ekleyelim
y.Range("A5") = "ÜRÜN ADI"
y.Range("B5") = "KAS.NO"
y.Range("C5") = "NOT"
y.Range("D5") = "AD./KG"
y.Range("E5") = "FİYAT"
y.Range("F5") = "TUTAR"
y.Range("A5:F5").Borders(xlEdgeBottom).LineStyle = 1

' Verileri kopyalayalım
x = WorksheetFunction.CountA(Range("A7:A28")) + 6
For i = 7 To x
y.Cells(i - 1, 1) = Cells(i, 1).Value
y.Cells(i - 1, 2) = Cells(i, 3).Value
y.Cells(i - 1, 3) = Cells(i, 4).Value
y.Cells(i - 1, 4) = Cells(i, 5).Value
y.Cells(i - 1, 5) = Cells(i, 6).Value
y.Cells(i - 1, 6) = Cells(i, 7).Value
Next i

' Toplam hücresini ayarla
y.Range("A" & x + 1 & ":F" & x + 1).Borders(xlEdgeTop).LineStyle = 2
y.Range("A" & x + 1 & ":F" & x + 1).Borders(xlEdgeBottom).LineStyle = 2
y.Range("A" & x + 1) = "TOPLAM"
y.Range("E" & x + 1 & ":F" & x + 1).Merge
y.Range("E" & x + 1).NumberFormat = "#,##0.00 $"
y.Range("E" & x + 1) = WorksheetFunction.Sum(Range("G7:G30"))
y.Range("E" & x + 1).HorizontalAlignment = xlRight

' Toplam hücresini biçimlendir
y.Range("A" & x + 1 & ":F" & x + 1).Font.Bold = True
y.Range("A" & x + 1 & ":F" & x + 1).Font.Size = 8

' Bilgilendirme satırlarını ekle
y.Range("A" & x + 3 & ":F" & x + 3).Merge
y.Range("A" & x + 3).HorizontalAlignment = xlLeft
y.Range("A" & x + 3) = "BİLGİ AMAÇLIDIR. MALİ DEĞERİ YOKTUR."
y.Range("A" & x + 4 & ":F" & x + 4).Merge
y.Range("A" & x + 4).HorizontalAlignment = xlLeft
y.Range("A" & x + 4) = " "

' Yazıcıyı seç
PrinterName = Application.Dialogs(xlDialogPrinterSetup).Show
If PrinterName <> "" Then
' Yazdır
x = y.Cells(Rows.Count, 2).End(xlUp).Row
y.Range("A1:F" & x + 31).PrintOut Copies:=1, ActivePrinter:=PrinterName, Collate:=True
Else
MsgBox "Yazıcı seçilmedi! İşlem iptal edildi."
End If

Set y = Nothing
End Sub
Genişletmek için tıkla ...
Bu makro çalışıyor ancak şöyle bir sorun var. Yazdır butonuna bastığımızda yazıcı seçim ekranı geldiği için nokta vuruşlu yazıcıyı seçtiğimiz anda diğer excel dosyalarıda otomatikman aynı yazıcıyı kullanmaya başlıyor.

Sadece makronun çalıştığı ilgili sayfada "TS009: OKI ML3320 TR (2 yönlendirildi)" isimli bu yazıcıyı sabit kullanabileceğimiz şekilde bir düzenleme yapma ihtimalimiz varmı acaba? Yazıcı seçim ekranı gelmeden ve diğer excellerin yazıcısı değişmeden.
 
Z

zehirlee

Katılım
15 Aralık 2017
Mesajlar
105
Excel Vers. ve Dili
Microsoft Office Ev ve İş 2013 - 32 bit
Altın Üyelik Bitiş Tarihi
21/12/2022
Soundcraft' Alıntı:
Bu makro çalışıyor ancak şöyle bir sorun var. Yazdır butonuna bastığımızda yazıcı seçim ekranı geldiği için nokta vuruşlu yazıcıyı seçtiğimiz anda diğer excel dosyalarıda otomatikman aynı yazıcıyı kullanmaya başlıyor.

Sadece makronun çalıştığı ilgili sayfada "TS009: OKI ML3320 TR (2 yönlendirildi)" isimli bu yazıcıyı sabit kullanabileceğimiz şekilde bir düzenleme yapma ihtimalimiz varmı acaba? Yazıcı seçim ekranı gelmeden ve diğer excellerin yazıcısı değişmeden.
Genişletmek için tıkla ...

denermisiniz

Sub Fiş_Yazdır()
Dim y As Worksheet
Dim x As Long
Dim PrinterName As String

' Yazdırma işlemi için kullanılacak sayfayı belirle
Set y = Sheets("Yazdır")

' Belirli bir aralıktaki hücreleri temizle
y.Range("A3:F50").ClearContents

' Belirli bir aralıktaki hücrelerin birleşimini çöz
y.Range("A5:F50").UnMerge

' Belirli bir aralıktaki hücre sınırlarının çizgisini kaldır
y.Range("A3:F500").Borders.LineStyle = 0

' Belirli bir aralıktaki metin biçimini değiştir
y.Range("A3:F50").Font.Bold = False
y.Range("A3:F50").Font.Size = 8
y.Range("A3:F50").RowHeight = 17
y.Range("A3:F50").VerticalAlignment = xlBottom
y.Range("A3:F50").WrapText = True
y.Rows("6:160").AutoFit
y.Range("A5:F5").Font.Bold = True

' Tarih ve Fiş No bilgisini ekleyelim
y.Range("A3") = "TARİH : " & Format(Date, "dd.mm.yyyy")
y.Range("C3") = "FİŞ NO : " & Format(Range("AA2"), "0000")

' Başlık satırını ekleyelim
y.Range("A5") = "ÜRÜN ADI"
y.Range("B5") = "KAS.NO"
y.Range("C5") = "NOT"
y.Range("D5") = "AD./KG"
y.Range("E5") = "FİYAT"
y.Range("F5") = "TUTAR"
y.Range("A5:F5").Borders(xlEdgeBottom).LineStyle = 1

' Verileri kopyalayalım
x = WorksheetFunction.CountA(Range("A7:A28")) + 6
For i = 7 To x
y.Cells(i - 1, 1) = Cells(i, 1).Value
y.Cells(i - 1, 2) = Cells(i, 3).Value
y.Cells(i - 1, 3) = Cells(i, 4).Value
y.Cells(i - 1, 4) = Cells(i, 5).Value
y.Cells(i - 1, 5) = Cells(i, 6).Value
y.Cells(i - 1, 6) = Cells(i, 7).Value
Next i

' Toplam hücresini ayarla
y.Range("A" & x + 1 & ":F" & x + 1).Borders(xlEdgeTop).LineStyle = 2
y.Range("A" & x + 1 & ":F" & x + 1).Borders(xlEdgeBottom).LineStyle = 2
y.Range("A" & x + 1) = "TOPLAM"
y.Range("E" & x + 1 & ":F" & x + 1).Merge
y.Range("E" & x + 1).NumberFormat = "#,##0.00 $"
y.Range("E" & x + 1) = WorksheetFunction.Sum(Range("G7:G30"))
y.Range("E" & x + 1).HorizontalAlignment = xlRight

' Toplam hücresini biçimlendir
y.Range("A" & x + 1 & ":F" & x + 1).Font.Bold = True
y.Range("A" & x + 1 & ":F" & x + 1).Font.Size = 8

' Bilgilendirme satırlarını ekle
y.Range("A" & x + 3 & ":F" & x + 3).Merge
y.Range("A" & x + 3).HorizontalAlignment = xlLeft
y.Range("A" & x + 3) = "BİLGİ AMAÇLIDIR. MALİ DEĞERİ YOKTUR."
y.Range("A" & x + 4 & ":F" & x + 4).Merge
y.Range("A" & x + 4).HorizontalAlignment = xlLeft
y.Range("A" & x + 4) = " "

' Belirli bir yazıcı adını ayarla
PrinterName = "TS009: OKI ML3320 TR (2 yönlendirildi)"

' Yazdır
x = y.Cells(Rows.Count, 2).End(xlUp).Row
y.Range("A1:F" & x + 31).PrintOut Copies:=1, ActivePrinter:=PrinterName, Collate:=True

Set y = Nothing
End Sub
 
Soundcraft

Soundcraft

Altın Üye
Katılım
29 Aralık 2005
Mesajlar
33
Excel Vers. ve Dili
Office 2016 TR 64 Bit
Altın Üyelik Bitiş Tarihi
05-08-2026
zehirlee' Alıntı:
denermisiniz

Sub Fiş_Yazdır()
Dim y As Worksheet
Dim x As Long
Dim PrinterName As String

' Yazdırma işlemi için kullanılacak sayfayı belirle
Set y = Sheets("Yazdır")

' Belirli bir aralıktaki hücreleri temizle
y.Range("A3:F50").ClearContents

' Belirli bir aralıktaki hücrelerin birleşimini çöz
y.Range("A5:F50").UnMerge

' Belirli bir aralıktaki hücre sınırlarının çizgisini kaldır
y.Range("A3:F500").Borders.LineStyle = 0

' Belirli bir aralıktaki metin biçimini değiştir
y.Range("A3:F50").Font.Bold = False
y.Range("A3:F50").Font.Size = 8
y.Range("A3:F50").RowHeight = 17
y.Range("A3:F50").VerticalAlignment = xlBottom
y.Range("A3:F50").WrapText = True
y.Rows("6:160").AutoFit
y.Range("A5:F5").Font.Bold = True

' Tarih ve Fiş No bilgisini ekleyelim
y.Range("A3") = "TARİH : " & Format(Date, "dd.mm.yyyy")
y.Range("C3") = "FİŞ NO : " & Format(Range("AA2"), "0000")

' Başlık satırını ekleyelim
y.Range("A5") = "ÜRÜN ADI"
y.Range("B5") = "KAS.NO"
y.Range("C5") = "NOT"
y.Range("D5") = "AD./KG"
y.Range("E5") = "FİYAT"
y.Range("F5") = "TUTAR"
y.Range("A5:F5").Borders(xlEdgeBottom).LineStyle = 1

' Verileri kopyalayalım
x = WorksheetFunction.CountA(Range("A7:A28")) + 6
For i = 7 To x
y.Cells(i - 1, 1) = Cells(i, 1).Value
y.Cells(i - 1, 2) = Cells(i, 3).Value
y.Cells(i - 1, 3) = Cells(i, 4).Value
y.Cells(i - 1, 4) = Cells(i, 5).Value
y.Cells(i - 1, 5) = Cells(i, 6).Value
y.Cells(i - 1, 6) = Cells(i, 7).Value
Next i

' Toplam hücresini ayarla
y.Range("A" & x + 1 & ":F" & x + 1).Borders(xlEdgeTop).LineStyle = 2
y.Range("A" & x + 1 & ":F" & x + 1).Borders(xlEdgeBottom).LineStyle = 2
y.Range("A" & x + 1) = "TOPLAM"
y.Range("E" & x + 1 & ":F" & x + 1).Merge
y.Range("E" & x + 1).NumberFormat = "#,##0.00 $"
y.Range("E" & x + 1) = WorksheetFunction.Sum(Range("G7:G30"))
y.Range("E" & x + 1).HorizontalAlignment = xlRight

' Toplam hücresini biçimlendir
y.Range("A" & x + 1 & ":F" & x + 1).Font.Bold = True
y.Range("A" & x + 1 & ":F" & x + 1).Font.Size = 8

' Bilgilendirme satırlarını ekle
y.Range("A" & x + 3 & ":F" & x + 3).Merge
y.Range("A" & x + 3).HorizontalAlignment = xlLeft
y.Range("A" & x + 3) = "BİLGİ AMAÇLIDIR. MALİ DEĞERİ YOKTUR."
y.Range("A" & x + 4 & ":F" & x + 4).Merge
y.Range("A" & x + 4).HorizontalAlignment = xlLeft
y.Range("A" & x + 4) = " "

' Belirli bir yazıcı adını ayarla
PrinterName = "TS009: OKI ML3320 TR (2 yönlendirildi)"

' Yazdır
x = y.Cells(Rows.Count, 2).End(xlUp).Row
y.Range("A1:F" & x + 31).PrintOut Copies:=1, ActivePrinter:=PrinterName, Collate:=True

Set y = Nothing
End Sub
Genişletmek için tıkla ...
Malesef yine burada seçili olan haricinde varsayılan yazıcıya gönderiyor.
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst