PDF文本输出的相关问题

范德萨 · 发表于 2015-10-30 21:34

期待高手们能出手

范德萨 · 发表于 2015-10-30 21:38

'打开PDF文件，并选中文本
Dim objAcroApp As New Acrobat.AcroApp
Dim objAcroAVDoc As New Acrobat.AcroAVDoc
Dim lRet As Long
lRet = objAcroApp.Show
lRet = objAcroAVDoc.Open(路径+测试文件1, "")
lRet = objAcroAVDoc.FindText(测试文本, 0, 1, 1)
lRet = objAcroAVDoc.ShowTextSelect()
lRet = objAcroAVDoc.Close(1)
lRet = objAcroApp.Hide
lRet = objAcroApp.Exit
Set objAcroAVDoc = Nothing
Set objAcroApp = Nothing

复制代码

范德萨 · 发表于 2015-10-30 21:46

'pdf生成txt
Sub cmd_imp()
Dim PDF_Path As String
PDF_Path = "C:\222.PDF"
Call Imp_Into_TXT(PDF_Path)
End Sub
Sub Imp_Into_TXT(PDF_File As String)
Dim AC_PD As Acrobat.AcroPDDoc
Dim AC_Hi As Acrobat.AcroHiliteList
Dim AC_PG As Acrobat.AcroPDPage
Dim AC_PGTxt As Acrobat.AcroPDTextSelect
Dim WS_PDF As Worksheet
Dim RW_Ct As Long
Dim Col_Num As Integer
Dim Li_Row As Long
Dim Yes_Fir As Boolean
Li_Row = Rows.Count
Dim Ct_Page As Long
Dim i As Long, j As Long, k As Long
Dim T_Str As String
Dim Hld_Txt As Variant
RW_Ct = 0
Col_Num = 1
Application.ScreenUpdating = False
Set AC_PD = New Acrobat.AcroPDDoc
Set AC_Hi = New Acrobat.AcroHiliteList
AC_Hi.Add 0, 32767
Dim str$
文件保存路径 = ThisWorkbook.Path & ""
TXT文件路径 = Dir(文件保存路径 & "" & "文档第" & i & "页.txt")
With AC_PD
.Open PDF_File
Ct_Page = .GetNumPages
If Ct_Page = -1 Then
MsgBox PDF_File & " 文件错误"
.Close
GoTo h_end
End If
Set WS_PDF = Worksheets("Sheet1")
For i = 1 To Ct_Page
Set AC_PG = .AcquirePage(i - 1)
Set AC_PGTxt = AC_PG.CreateWordHilite(AC_Hi)
T_Str = ""
If Not AC_PGTxt Is Nothing Then
With AC_PGTxt
Debug.Print .GetNumText
For j = 0 To .GetNumText - 1
T_Str = T_Str & .GetText(j)
Next j
End With
End If
Open 文件保存路径 & "" & "文档第" & i & "页.txt" For Output As #1
If Len(str) > 0 Then Print #1, str
Print #1, T_Str;
Close #1
Next i
.Close
End With
Application.ScreenUpdating = True
MsgBox "转换完毕"
h_end:
Set WS_PDF = Nothing
Set AC_PGTxt = Nothing
Set AC_PG = Nothing
Set AC_Hi = Nothing
Set AC_PD = Nothing
End Sub

复制代码

范德萨 · 发表于 2015-10-30 21:51

'获取文档当前选择工具
'Acrobat 4,5,6 版本
' Dim objAcroApp As Acrobat.CAcroApp
' Set objAcroApp = CreateObject("AcroExch.App")
'Acrobat 7,8,9,10,11 版本
Dim objAcroApp As New Acrobat.AcroApp
Dim strName As String
strName = objAcroApp.GetActiveTool()
MsgBox "GetActiveTool Name = (" & strName & ")"
Set objAcroApp = Nothing

复制代码

范德萨 · 发表于 2015-10-30 21:52

'获取安装Acrobat的语言
'Acrobat 4,5,6 版本
' Dim objAcroApp As Acrobat.CAcroApp
' Set objAcroApp = CreateObject("AcroExch.App")
'
'Acrobat 7,8,9,10,11 版本
Dim objAcroApp As New Acrobat.AcroApp
Dim strLanguage As String
Debug.Print objAcroApp.GetLanguage
Select Case objAcroApp.GetLanguage
Case "JPN"
strLanguage = "Japanes (日語)"
Case "DEU"
strLanguage = "German (德语)"
Case "ENU"
strLanguage = "English (英语)"
Case "ESP"
strLanguage = "Spanish (西班牙语)"
Case "FRA"
strLanguage = "French (法语)"
Case "ITA"
strLanguage = "Italian (意大利语)"
Case "NLD"
strLanguage = "Dutch (荷兰语)"
Case "SVE"
strLanguage = "Swedish (瑞典语)"
Case "CHS"
strLanguage = "简体中文"
Case Else
strLanguage = "其他语言"
End Select
MsgBox "Acrobat Langauge=" & strLanguage
Set objAcroApp = Nothing

复制代码

范德萨 · 发表于 2015-10-30 21:53

获取当前打开pdf文档数量
'Acrobat 4,5,6 版本
' Dim objAcroApp As Acrobat.CAcroApp
' Set objAcroApp = CreateObject("AcroExch.App")
'
'Acrobat 7,8,9,10,11 版本
Dim objAcroApp As New Acrobat.AcroApp
Dim lCnt As Long
lCnt = objAcroApp.GetNumAVDocs
MsgBox "PDF Count=" & lCnt
Set objAcroApp = Nothing

复制代码

范德萨 · 发表于 2015-10-30 21:55

关闭所有打开的PDF文档
' Acrobat 4,5,6 版本
' Dim objAcroApp As Acrobat.CAcroApp
' Set objAcroApp = CreateObject("AcroExch.App")
'
' Acrobat 7,8,9,10,11 版本
Dim objAcroApp As New Acrobat.AcroApp

Dim lRet As Long '返回
lRet = objAcroApp.Show

lRet = objAcroApp.Hide
lRet = objAcroApp.Exit
Set objAcroApp = Nothing

范德萨 · 发表于 2015-10-30 22:00

添加水印
Dim pdApp As Acrobat.AcroApp
Dim pdDoc As Acrobat.AcroPDDoc
Dim pdPage As Acrobat.AcroPDPage
Dim jso As Object

Set pdApp = CreateObject("AcroExch.App")
Set pdDoc = CreateObject("AcroExch.PDDoc")

pdDoc.Open ("c:\1.pdf")
Set jso = pdDoc.GetJSObject
jso.addWatermarkFromText ("水印")

pdDoc.Save 1, "c:\4.pdf"
pdDoc.Close
Set pdDoc = Nothing
Set pdApp = Nothing

范德萨 · 发表于 2015-10-30 22:05

Option Explicit
'Win32 API
'Public Const HKEY_CLASSES_ROOT = &H80000000
'Public Const HKEY_CURRENT_USER = &H80000001
'Public Const HKEY_CURRENT_CONFIG = &H80000005
Public Const HKEY_LOCAL_MACHINE = &H80000002
'Public Const HKEY_LOCAL_MACHINE = &H80000002
'Public Const HKEY_USERS = &H80000003
'Public Const ERROR_SUCCESS = 0&
Type VS_FIXEDFILEINFO
dwSignature As Long
dwStrucVersion As Long
dwFileVersionMS As Long
dwFileVersionLS As Long
dwProductVersionMS As Long
dwProductVersionLS As Long
dwFileFlagsMask As Long
dwFileFlags As Long
dwFileOS As Long
dwFileType As Long
dwFileSubtype As Long
dwFileDateMS As Long
dwFileDateLS As Long
End Type
Public Declare Function RegCloseKey Lib "ADVAPI32" _
(ByVal hKey&) As Long
Public Declare Function RegOpenKeyEx Lib "ADVAPI32" _
Alias "RegOpenKeyExA" (ByVal hKey&, ByVal lpSubKey$, _
ByVal ulOptions&, ByVal samDesired&, phkResult&) As Long
Public Declare Function RegQueryValueExstr Lib "ADVAPI32" _
Alias "RegQueryValueExA" (ByVal hKey&, _
ByVal lpValueName$, ByVal lpReserved&, ByVal lpType&, _
ByVal lpdata$, lpcbData&) As Long
Public Declare Function GetFileVersionInfoSize Lib _
"Version.dll" Alias "GetFileVersionInfoSizeA" _
(ByVal lptstrFilename As String, lpdwHandle As Long) _
As Long
Public Declare Function GetFileVersionInfo Lib "Version.dll" _
Alias "GetFileVersionInfoA" _
(ByVal lptstrFilename As String, ByVal dwHandle As Long, _
ByVal dwLen As Long, lpdata As Any) As Long
Public Declare Function VerQueryValue Lib "Version.dll" _
Alias "VerQueryValueA" (pBlock As Any, _
ByVal lpSubBlock As String, lplpBuffer As Any, _
puLen As Long) As Long
Public Declare Sub MoveMemory Lib "kernel32.dll" _
Alias "RtlMoveMemory" (Destination As Any, _
Source As Any, ByVal Length As Long)
Public Declare Sub Sleep Lib "kernel32.dll" _
(ByVal dwMilliseconds As Long)
Private Sub 查看Acrobat安装路径和版本()
Const CON_APP = "Acrobat"
Dim strAcrobatPath As String
Dim strVersion As String
Dim strMsg As String
Call Get_Adobe_App_Info_nnn2(CON_APP, _
strAcrobatPath, strVersion, strMsg)
Debug.Print "AcrobatPath ='" & strAcrobatPath & "'" & vbCrLf & _
"Acrobat Version='" & strVersion & "'"
End Sub
Public Function Get_Adobe_App_Info_nnn2( _
ByVal strApp As String, _
ByRef strPath As String, _
ByRef strVersion As String, _
ByRef strMsg As String) As Boolean
On Error GoTo Err_Get_Adobe_App_Info_nnn2:
Dim strFileVersion As String
Dim strProductVersion As String
Dim strSubKey As String
Dim strRootKey As String
Dim InstallPathReg As Long
Dim lLength As Long
Dim lRet As Long
Dim strName As String
strMsg = ""
strRootKey = HKEY_LOCAL_MACHINE
If strApp = "Acrobat" Then
strSubKey = "SOFTWARE\Microsoft\Windows" & _
"CurrentVersion\App Paths\Acrobat.exe"
Else
strSubKey = "SOFTWARE\Microsoft\Windows" & _
"CurrentVersion\App Paths\AcroRd32.exe"
End If
lRet = RegOpenKeyEx(strRootKey, strSubKey, 0, 1, _
InstallPathReg)
strPath = String(250, Chr(0))
lLength = Len(strPath)
strName = ""
lRet = RegQueryValueExstr(InstallPathReg, strName, _
0, 0, strPath, lLength)
strPath = Trim$(Replace(strPath, Chr(0), " "))
If strPath = "" Then
strMsg = "Not Found Adobe apllication"
strVersion = vbNullString
Exit Function
End If
strPath = Left$(strPath, InStr(strPath, ".exe") + 3)
Call RegCloseKey(InstallPathReg)
Dim lngSizeOfVersionInfo As Long
Dim lngDummyHandle As Long
Dim bytDummyVersionInfo() As Byte
Dim lngPointerVersionInfo As Long
Dim lnglLengthVersionInfo As Long
Dim udtVSFixedFileInfo As VS_FIXEDFILEINFO
lngSizeOfVersionInfo = GetFileVersionInfoSize(strPath, _
lngDummyHandle)
ReDim bytDummyVersionInfo(lngSizeOfVersionInfo - 1)
lRet = GetFileVersionInfo(strPath, 0, _
lngSizeOfVersionInfo, bytDummyVersionInfo(0))
lRet = VerQueryValue(bytDummyVersionInfo(0), "", _
lngPointerVersionInfo, lnglLengthVersionInfo)
MoveMemory udtVSFixedFileInfo, _
ByVal lngPointerVersionInfo, Len(udtVSFixedFileInfo)
With udtVSFixedFileInfo
strFileVersion = _
CStr((.dwFileVersionMS \ 2 ^ 16) And &HFFFF&) & "." & _
CStr(.dwFileVersionMS And &HFFFF&) & "." & _
CStr((.dwFileVersionLS \ 2 ^ 16) And &HFFFF&) & "." & _
CStr(.dwFileVersionLS And &HFFFF&)
strProductVersion = _
CStr((.dwProductVersionMS \ 2 ^ 16) And &HFFFF&) & "." & _
CStr(.dwProductVersionMS And &HFFFF&) & "." & _
CStr((.dwProductVersionLS \ 2 ^ 16) And &HFFFF&) & "." & _
CStr(.dwProductVersionLS And &HFFFF&)
strVersion = CStr((.dwProductVersionMS \ 2 ^ 16) And &HFFFF&)
End With
Get_Adobe_App_Info_nnn2 = True
Exit Function
Err_Get_Adobe_App_Info_nnn2:
strMsg = "Run Time Error" & vbCrLf & Err.Number & _
vbCrLf & Err.Description
Get_Adobe_App_Info_nnn2 = False
End Function

复制代码

范德萨 · 发表于 2015-10-30 22:06

获取页面尺寸
Dim objAcroAVDoc As New Acrobat.AcroAVDoc
Dim objAcroPDDoc As Acrobat.AcroPDDoc
Dim objAcroPDPage As Acrobat.AcroPDPage
Dim objAcroPoint As Acrobat.AcroPoint
Dim lRet As Long
lRet = objAcroAVDoc.Open(测试文件1, "")
Set objAcroPDDoc = objAcroAVDoc.GetPDDoc
Set objAcroPDPage = objAcroPDDoc.AcquirePage(0)
Set objAcroPoint = objAcroPDPage.GetSize
Debug.Print "objAcroPoint.x=" & objAcroPoint.x
Debug.Print "objAcroPoint.y=" & objAcroPoint.y
lRet = objAcroAVDoc.Close(1)
Set objAcroPoint = Nothing
Set objAcroPDPage = Nothing
Set objAcroPDDoc = Nothing
Set objAcroAVDoc = Nothing

复制代码

		自动登录	找回密码
密码			免费注册

[求助] PDF文本输出的相关问题

评分

浏览过的版块