köprü yazdırma

[kanka]

excelde oluşturduğum köprü vasıtası ile oluşturduğum fotoğraf yada power point dosyalarını bir buton vasıtası ile yazdırmak istiyorum.
bu konu da yardımcı olur musunuz

 

[mrtk58]

aynı konu için destek alabilirmiyim

 

[Korhan Ayhan]

Kendi dosyanıza uyarlarsınız..

Option Explicit

Sub Print_Hyperlink_File()
    Dim S1 As Worksheet, Rng As Range, File_Path As String, Count_File As Long
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Set S1 = Sheets("Sheet1")
    
    For Each Rng In S1.Range("A2:A" & S1.Cells(S1.Rows.Count, 1).End(3).Row)
        If Rng.Value <> "" Then
            If Rng.HasFormula Then
                If InStr(Rng.Formula, "HYPERLINK") > 0 Then
                    DoEvents
                    Count_File = Count_File + 1
                    File_Path = Evaluate(Replace(Split(Rng.Formula, ",")(0), "HYPERLINK", "") & ")")
                    VBA.CreateObject("Shell.Application").Namespace(0).ParseName(File_Path).InvokeVerb ("Print")
                End If
            Else
                If Rng.Hyperlinks.Count > 0 Then
                    DoEvents
                    Count_File = Count_File + 1
                    File_Path = Rng.Hyperlinks.Item(1).Address
                    VBA.CreateObject("Shell.Application").Namespace(0).ParseName(File_Path).InvokeVerb ("Print")
                End If
            End If
        End If
    Next

    Set S1 = Nothing

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

    If Count_File = 0 Then
        MsgBox "Yazdırılacak dosya bulunamadı!", vbExclamation
    Else
        MsgBox Format(Count_File, "#,##0") & " adet dosya yazıcıya gönderilmiştir.", vbInformation
    End If
End Sub