如何根据pdf文件列表，批量打印(问题已经解决）

zldccmx

你的满意是俺最大的欣慰

zzf_

感谢老朽大师
Sub CTRLPDF()
Dim PDFApp As New Acrobat.AcroPDDoc
Dim filename As String
For i = 1 To 9
    filename = Cells(i, 1)
    PDFApp.Open filename
    Cells(i, 7) = PDFApp.GetNumPages
    PDFApp.Close ‘这里卡壳了半天！ 原来文件打开了，还需关闭才行
    Next i
End Sub
Adobe的内置函数，的确挺有趣！值得琢磨一下

zzf_

Sub 统计1()  '由原版本改过来，统计不含子文件夹
'--------------
Worksheets("主界面").Cells(j, 3) = MyFile
fTy = Cells(4, 2)
Select Case fTy
Case "pdf"
            
                    PDFApp.Open MyFile
                    Cells(j, 4) = PDFApp.GetNumPages
                    PDFApp.Close
            
Case "doc" ‘代码来自网络，不知为何经常出错！ 看到文件一个个打开，再关闭，容易当机
              Documents.Open MyFile
              Set myRange = ActiveDocument.Content
              myRange.Collapse Direction:=wdEnd
              Documents(1).Repaginate
              Cells(j, 4) = ActiveDocument.BuiltinDocumentProperties(wdPropertyPages).Value
              Documents(1).Close False
Case Else
              End Select
'--------------
j = j + 1
  myNa = Dir()
  Loop
End Sub

zzf_

Cells(6, 4).ClearContents
          fTy = Cells(4, 2)
Select Case fTy
   Case "pdf"
                    PDFApp.Open MyFile
                    Cells(6, 4) = "文件总页数"
                    Cells(j, 4) = PDFApp.GetNumPages
                    PDFApp.Close
  Case "doc" '来自老朽代码的修改，好多了
              Set MyDoc = GetObject(Cells(j, 3).Value)
              Cells(6, 4) = "文件总页数"
              Cells(j, 4) = MyDoc.ActiveWindow.ActivePane.Pages.Count
              Set MyDoc = Nothing   
   Case "*"
              nN = InStrRev(MyFile, ".")
              Cells(6, 4) = "文件类型"
              Cells(j, 4) = Mid(MyFile, nN + 1)
   Case Else
              End Select

[ 本帖最后由 zzf_ 于 2010-5-4 14:06 编辑 ]

zzf_

Private Sub CommandButton1_Click()
'PDF、DOC文件批量打印模块
Dim Rng As Range
For Each Rng In Selection
fTy = Cells(4, 2)
Select Case fTy
Case "pdf"
    If Rng.Column = 3 And Rng.Row >= 7 Then
        文件名 = Rng.Value
        jf = InStrRev(文件名, "\")
        P_A = Left(文件名, jf - 1)
        文件名 = Mid(文件名, jf + 1)
        ChDir P_A
        ChDrive Left(Rng.Value, 1)
      
       'Shell "C:\PROGRA~1\FOXITS~1\FOXITR~1\FOXITR~1.EXE" / p & 文件名 '
    Shell "C:\Program Files\Adobe\Acrobat 7.0\Acrobat\Acrobat.exe /p /h " & 文件名 'Acrobat 7.0 professional调试通过
    End If
Case "doc"
Dim appWD As Object
On Error Resume Next
Set appWD = CreateObject("Word.Application")
If Err.Number <> 0 Then Err.Clear: Set appWD = CreateObject("Word.Application")
appWD.Visible = False
appWD.Documents.Open filename:=Cells(Rng.Row, 3).Value
appWD.PrintOut
appWD.Documents.Close SaveChanges:=False
appWD.Application.Quit False
Set appWD = Nothing
Case Else
     MsgBox ("不支持打印格式")
End Select
    Next
End Sub

[ 本帖最后由 zzf_ 于 2010-5-5 01:05 编辑 ]

zzf_

学习http://club.excelhome.net/viewth ... ht=shell&page=1 小议shell语句语法中的小门道
（一）
Case "pdf"
    If Rng.Column = 3 And Rng.Row >= 7 Then
      
        '-------------------------http://club.excelhome.net/viewth ... ht=shell&page=1
        文件名 = Chr(34) & Rng.Value & Chr(34)            
       ''Shell "C:\PROGRA~1\FOXITS~1\FOXITR~1\FOXITR~1.EXE" / p & 文件名
    Shell "C:\Program Files\Adobe\Acrobat 7.0\Acrobat\Acrobat.exe /p /h " & 文件名
   
        '-------------------------
End If
（二）
Case "pdf"
    If Rng.Column = 3 And Rng.Row >= 7 Then
               文件名 = Rng.Value     
Dim AcrApp As Object
Dim acrDoc As Object
Dim acrPDDoc As Object
Dim ret As Long
Dim lngPage As Long

    Set AcrApp = CreateObject("AcroExch.App")
   'uncomment if you want to see the Acrobat window
   'ret = AcrApp.Show()
   
    Set acrDoc = CreateObject("AcroExch.AVDoc")
   
    acrDoc.Open 文件名, "PDF Print"
    Set acrPDDoc = acrDoc.GetPDDoc
    lngPages = acrPDDoc.GetNumPages
    Debug.Print lngPages
    ret = acrDoc.PrintPages(0, lngPages - 1, 2, True, True) '好用
    Set acrDoc = Nothing
    Set acrPDDoc = Nothing
    AcrApp.CloseAllDocs
    AcrApp.Exit
    Set AcrApp = Nothing
End If

zzf_

基本雏形
宏2.71828

[ 本帖最后由 zzf_ 于 2010-9-22 12:49 编辑 ]

zzf_

基本雏形
宏密码2.71828

goons

楼主如何打开你的文件啊?

zzf_

2.71828 2.71828