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

Soundcraft · 29 Şubat 2024

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.

zehirlee · 29 Şubat 2024

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

muhasebeciyiz · 29 Şubat 2024

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 · 29 Şubat 2024

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

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

Soundcraft · 29 Şubat 2024

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

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 · 29 Şubat 2024

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

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

zehirlee · 29 Şubat 2024

cavanoos' Alıntı:
Kodunuzu denedim. Aşağıdaki satırda hata verdi.
SelectedPrinter = PrinterDialog.DeviceName

anladım bende çalışmıştı.

zehirlee · 29 Şubat 2024

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

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 · 29 Şubat 2024

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

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 · 29 Şubat 2024

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

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.

zehirlee · 1 Mart 2024

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.

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 · 1 Mart 2024

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

Malesef yine burada seçili olan haricinde varsayılan yazıcıya gönderiyor.

Korhan Ayhan · 1 Mart 2024

Linkteki konuların belki faydası olabilir..

Sorgu için arama sonuçları: activeprinter

www.excel.web.tr

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

Administrator