批量打印选中单元格里的超链接文件

liuzhixiang

liuzhixiang

求助表格见附件

hasyh2008

试试！！！！！！！！

hasyh2008

Sub dayin()
  On Error Resume Next
  Dim WB As Workbook
  Dim SH As Worksheet
  Dim Str$
  Dim Rng As Range
  For Each Rng In Selection
    Str = ThisWorkbook.Path & "/检查表/sh型/" & Rng.Text & ".xls"
    Set WB = Workbooks.Open(Str)
    For Each SH In Worksheets
      If Application.WorksheetFunction.CountA(SH.Cells) > 0 Then
        SH.PrintOut copies:=1
      End If
    Next SH
    ActiveWorkbook.Saved = True
    ActiveWorkbook.Close
  Next Rng
  Set WB = Nothing
  Set SH = Nothing
  Set Rng = Nothing
End Sub

liuzhixiang

hasyh2008 发表于 2022-5-2 08:27
Sub dayin()
  On Error Resume Next
  Dim WB As Workbook

此代码可以打印超链接是表格的，当超链接里的文件是PDF格式时候，就无法打印了

liuzhixiang

hasyh2008 发表于 2022-5-2 08:27
Sub dayin()
  On Error Resume Next
  Dim WB As Workbook

我的描述有误差，导致只能打印表格 重新上附件，我要打印的是超链接里PDF格式的，打印份数可以自定义，谢谢

hasyh2008

再试试！！！

liuzhixiang

hasyh2008 发表于 2022-5-2 19:20
再试试！！！

还是不对，1：你的代码把列里面的全打印了 （要求选中哪个单元格或框选多个单元格里的都打印） 2:单元格里是不带有.pdf字段 的， 谢谢
下面是我原来的代码，不知道哪里有问题 没有反应了
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Sub test()
Dim Rng As Range
If LCase(TypeName(Selection)) = "range" Then
    For Each Rng In Selection.Cells
        If Rng.EntireRow.Hidden = False And Rng.Hyperlinks.Count > 0 Then
            If Dir(Rng.Hyperlinks(1).Address) <> "" Then ShellExecute 0, "print", Rng.Hyperlinks(1).Address, vbNullString, vbNullString, vbNormalFocus
        End If
    Next Rng
End If
End Sub