VBA İLE WEB SAYFASI YAZDIRMA

[Korhan Ayhan]

İlk önerdiğim kod da yazdırma işlemini yapan satırı siliniz.

Silinecek satır;
ie.ExecWB 6, 2

Yerine aşağıdaki satırları yazıp deneyin. Ben deneyemedim.

Call SendKeys("^p", True)
Call SendKeys("~", True)

 

[editedbycenk]

İlk önerdiğim kod da yazdırma işlemini yapan satırı siliniz.

Silinecek satır;
ie.ExecWB 6, 2

Yerine aşağıdaki satırları yazıp deneyin. Ben deneyemedim.

Call SendKeys("^p", True)
Call SendKeys("~", True)

Hocam bu kodda internet explorerden değilde google chrome dan açtırmamız mümkünmü ona uygun kod yazabilir misin ?

 

[Korhan Ayhan]

Chrome için Selenium gerekiyor sanırım. Ben onu sisteme yükleyemiyorum.

Sisteminde yüklü olan başka bir arkadaşımız bu konuda belki destek olabilir.

 

[EErkut]

Bir de aklıma PDF dosyasını bilgisayara kaydedip yazdırma yöntemi geldi.

Bir deneyin belki sonuç alabilirsiniz.

Option Explicit

Sub Download_File_Then_Print()
    Dim My_Url As String
    Dim My_Http As Object
    Dim My_Stream As Object
    Dim File_Name As String
    Dim My_Service As Object
    Dim Activate_App As Variant
    Dim My_App As Object
  
    Set My_Http = CreateObject("Microsoft.XmlHttp")
    Set My_Stream = CreateObject("AdoDb.Stream")
  
    My_Url = "https://www.zebra.com/content/dam/zebra_new_ia/en-us/manuals/barcode-scanners/ls2208-product-reference-guide-en-us.pdf"
    File_Name = Environ("UserProfile") & "\Desktop\Deneme.pdf"

    My_Http.Open "Get", My_Url, False
    My_Http.Send

    My_Url = My_Http.ResponseBody
    My_Stream.Open
    My_Stream.Type = 1
    My_Stream.Write My_Http.ResponseBody
    My_Stream.SaveToFile (File_Name), 2
    My_Stream.Close
  
    CreateObject("Shell.Application").Namespace(0).ParseName(File_Name).InvokeVerb ("Print")
  
    Application.Wait Now + TimeSerial(0, 0, 3)
  
    Set My_Service = GetObject("winmgmts:")
    Set Activate_App = My_Service.ExecQuery("Select * From Win32_Process")
  
    For Each My_App In Activate_App
        If InStr(1, My_App.Name, "PDF") > 0 Then My_App.Terminate
    Next
  
    Kill File_Name
  
    MsgBox "PDF dosyası yazıcıya gönderilmiştir."
End Sub

Merhaba,
Bu kod için linkte dosya bulunamadıysa mesaj verdirebilir miyiz?
Destek için şimdiden teşekkür ederim

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Download_File_Then_Print()
    Dim My_Url As String
    Dim My_Http As Object
    Dim My_Stream As Object
    Dim File_Name As String
    Dim My_Service As Object
    Dim Activate_App As Variant
    Dim My_App As Object
  
    Set My_Http = CreateObject("Microsoft.XmlHttp")
    Set My_Stream = CreateObject("AdoDb.Stream")
  
    My_Url = "https://www.zebra.com/content/dam/zebra_new_ia/en-us/manuals/barcode-scanners/ls2208-product-reference-guide-en-us.pdf"
    File_Name = Environ("UserProfile") & "\Desktop\Deneme.pdf"

    My_Http.Open "Get", My_Url, False
    My_Http.Send

    If My_Http.Status <> 200 Then
        MsgBox "Dosya bulunamadı!", vbCritical
        Exit Sub
    End If
        
    My_Url = My_Http.ResponseBody
    My_Stream.Open
    My_Stream.Type = 1
    My_Stream.Write My_Http.ResponseBody
    My_Stream.SaveToFile (File_Name), 2
    My_Stream.Close
  
    CreateObject("Shell.Application").Namespace(0).ParseName(File_Name).InvokeVerb ("Print")
  
    Application.Wait Now + TimeSerial(0, 0, 3)
  
    Set My_Service = GetObject("winmgmts:")
    Set Activate_App = My_Service.ExecQuery("Select * From Win32_Process")
  
    For Each My_App In Activate_App
        If InStr(1, My_App.Name, "PDF") > 0 Then My_App.Terminate
    Next
  
    Kill File_Name
  
    MsgBox "PDF dosyası yazıcıya gönderilmiştir."
End Sub

 

[EErkut]

Korhan Hocam
Bilginize becerinize sağlık....
Teşekkür ederim