Excelmacros来打印超链接的文档

我正在尝试创build一个macros来打印活动电子表格上的所有超链接的文档。

单元格A1：A200包含超链接。 我想打开一个隐藏的Word应用程序 – 检查单元格A1超链接 – 如果存在打开链接 – 打印文档 – closures文档 – 移动到下一个单元格A2 – 检查A2等超链接…closures隐藏的字应用程序结束。 如果单元格不包含超链接，则移动到下一个单元格，但没有任何错误。

我已经玩弄了，而且我还没有走得太远，所以我希望有人能够帮助我。

不是所有的文件都是文字有些是开放式的.ods文件，所以如果我可以打开超链接并用本地程序打印，那么closures这将是更好，但我很乐意将所有的.od文件转换为.doc，使其工作如果更轻松。

谢谢！

编辑：此代码将只打印随机链接不是全部。

Sub ExportToWordAndPrint() Const Ttl As String = "Word Print" Dim cell As Range, rng As Range Dim FullNameOfFile As String Dim WordApp As Object, MyDoc As Object On Error Resume Next Set WordApp = GetObject(, "Word.Application") If Err.Number <> 0 Then Set WordApp = CreateObject("Word.Application") On Error GoTo 0 If WordApp Is Nothing Then MsgBox "Microsoft Word is not installed on this computer - operation cancelled.", vbCritical + vbOKOnly, Ttl Exit Sub End If WordApp.Visible = False Set rng = Selection For Each cell In rng On Error Resume Next FullNameOfFile = "" FullNameOfFile = cell.Hyperlinks(1).Address On Error GoTo 0 If FullNameOfFile <> "" Then 'cell may not have contained a Hyperlink If Dir(FullNameOfFile) <> "" Then 'cell may contain a Hyperlink, but the file itself may not exist With WordApp Set MyDoc = .documents.Open(Filename:=FullNameOfFile) MyDoc.PrintOut .ActiveWindow.Close SaveChanges:=False End With End If End If Next cell Set WordApp = Nothing End Sub 

编辑到代码inputdebugging线。 两个End If行已经被删除在Next Cell之上，以避免编译错误。

 Sub ExportToWordAndPrint() Const Ttl As String = "Word Print" Dim cell As Range, rng As Range Dim FullNameOfFile As String Dim WordApp As Object, MyDoc As Object On Error Resume Next Set WordApp = GetObject(, "Word.Application") If Err.Number <> 0 Then Set WordApp = CreateObject("Word.Application") On Error GoTo 0 If WordApp Is Nothing Then MsgBox "Microsoft Word is not installed on this computer - operation cancelled.", vbCritical + vbOKOnly, Ttl Exit Sub End If WordApp.Visible = False Set rng = Selection For Each cell In rng On Error Resume Next FullNameOfFile = "" FullNameOfFile = cell.Hyperlinks(1).Address On Error GoTo 0 If FullNameOfFile <> "" Then Debug.Print cell.Address & " failed, appears to have no hyperlink" If Dir(FullNameOfFile) <> "" Then Debug.Print cell.Address & " failed, appears to have wrong filename" Debug.Print cell.Address & " should print" With WordApp Set MyDoc = .documents.Open(Filename:=FullNameOfFile) MyDoc.PrintOut .ActiveWindow.Close SaveChanges:=False End With Next cell Set WordApp = Nothing End Sub 

第一个链接现在只打印其余的。 是我没有select范围的问题？ 不知道在哪里把这个？

感谢大家的帮助！

Answer 1

所以，正如我从你的post了解，DOC文件打印没关系。

您可以使用打印ODS文档的方法是使用命令行让OpenOffice打印文档。 正如本网站所示： https ： //wiki.openoffice.org/wiki/Documentation/FAQ/General/Is_there_a_way_to_print_a_batch_of_files_without_opening_each_of_them_in_OOo%3F

 OfficeID = Shell "openoffice -pt ""PRINTER-NAME"" FILENAME" 

如果应用程序在完成后不退出，则可以使用OfficeID来终止该过程。 例如使用Shell "TASKKILL /PID " & CStr(OfficeID) 。

注意：我没有尝试过这个，但应该让你开始。

更新

下面是我试图编辑的代码，但一些没有阅读post的评论者回复了这个，这就是为什么你没有看到它，这是添加Debug行的正确方法：

 Sub ExportToWordAndPrint() Const Ttl As String = "Word Print" Dim cell As Range, rng As Range Dim FullNameOfFile As String Dim WordApp As Object, MyDoc As Object On Error Resume Next Set WordApp = GetObject(, "Word.Application") If Err.Number <> 0 Then Set WordApp = CreateObject("Word.Application") On Error GoTo 0 If WordApp Is Nothing Then MsgBox "Microsoft Word is not installed on this computer - operation cancelled.", vbCritical + vbOKOnly, Ttl Exit Sub End If WordApp.Visible = False Set rng = Range("A4:A200") For Each cell In rng On Error Resume Next FullNameOfFile = "" FullNameOfFile = cell.Hyperlinks(1).Address On Error GoTo 0 If FullNameOfFile <> "" Then 'cell may not have contained a Hyperlink If Dir(FullNameOfFile) <> "" Then 'cell may contain a Hyperlink, but the file itself may not exist 'Debug.print cell.address & " should print" 'THIS ONE ADDED With WordApp Set MyDoc = .documents.Open(Filename:=FullNameOfFile) MyDoc.PrintOut .ActiveWindow.Close SaveChanges:=False End With Else 'THIS ONE ADDED 'Debug.print cell.address & " failed, appears to have wrong filename" End If Else 'THIS ONE ADDED 'Debug.print cell.address & " failed, appears to have no hyperlink" End If Next cell WordApp.Quit SaveChanges:=wdDoNotSaveChanges Set WordApp = Nothing End Sub