0

我需要帮助将此 Visual Basic 代码转换为与 MS Access 一起使用。现在我在 MS Excel 中使用它来使用表单中的数据填写 PDF，我想将我的数据库迁移到 MS Access，但仍然可以从中填写 PDF。

这是第一个 VB 模块。

Public Sub ListPDF_Fields()

Dim AcroExchAVDoc As CAcroAVDoc
Dim AcroExchApp As CAcroApp
Dim AFORMAUT As AFORMAUTLib.AFormApp
Dim FormField As AFORMAUTLib.Field
Dim FormFields As AFORMAUTLib.Fields
Dim bOK As Boolean
Dim sFields As String
Dim sTypes As String
Dim sFieldName As String

' For this procedure to work, computer must have a full version
' of Adobe Acrobat installed. Also, a reference to the following
' Type Libraries must be made:
'     AFormAut 1.0
'     Adobe Acrobat 7.0 (or newer)

On Error GoTo ErrorHandler

Set AcroExchApp = CreateObject("AcroExch.App")
Set AcroExchAVDoc = CreateObject("AcroExch.AVDoc")
bOK = AcroExchAVDoc.Open(ActiveWorkbook.Path & "\" & PDF_FILE, "")
AcroExchAVDoc.BringToFront
AcroExchApp.Hide

If (bOK) Then
    Set AFORMAUT = CreateObject("AFormAut.App")
    Set FormFields = AFORMAUT.Fields
    For Each FormField In FormFields
        With FormField
            sFieldName = .Name
            If .IsTerminal Then
                If sFields = "" Then
                    sFields = .Name
                    sTypes = .Type
                Else
                    sFields = sFields + "," + .Name
                    sTypes = sTypes + "," + .Type
                End If
            End If
        End With
    Next FormField
    AcroExchAVDoc.Close True
End If
Debug.Print sFields
Debug.Print sTypes

Set AcroExchAVDoc = Nothing
Set AcroExchApp = Nothing
Set AFORMAUT = Nothing
Set Field = Nothing
Exit Sub

ErrorHandler:
MsgBox "FieldList Error: " + Str(Err.Number) + " " + Err.Description + " " + Err.Source

End Sub

这是第二个VB模块

Option Explicit
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
Private Const SW_NORMAL = 1
Public Const PDF_FILE = "CX.pdf"
Public Sub MakeFDF()

Dim sFileHeader As String
Dim sFileFooter As String
Dim sFileFields As String
Dim sFileName As String
Dim sTmp As String
Dim lngFileNum As Long
Dim vClient As Variant

    ' Builds string for contents of FDF file and then writes file to workbook folder.
On Error GoTo ErrorHandler

sFileHeader = "%FDF-1.2" & vbCrLf & _
          "%âãÏÓ" & vbCrLf & _
          "1 0 obj<</FDF<</F(" & PDF_FILE & ")/Fields 2 0 R>>>>" & vbCrLf & _
          "endobj" & vbCrLf & _
          "2 0 obj[" & vbCrLf

sFileFooter = "]" & vbCrLf & _
          "endobj" & vbCrLf & _
          "trailer" & vbCrLf & _
          "<</Root 1 0 R>>" & vbCrLf & _
          "%%EO"

sFileFields = "<</T(PCSID)/V(---PCS_ID---)>>" & vbCrLf & "<</T(STATIONSN)/V(---STATION_SN---)>>" & vbCrLf & "<</T(XFMRSN)/V(---XFMR_SN---)>>" & vbCrLf

vClient = Range(Selection.Row & ":" & Selection.Row)

sFileFields = Replace(sFileFields, "---PCS_ID---", vClient(1, 1))
sFileFields = Replace(sFileFields, "---STATION_SN---", vClient(1, 2))
sFileFields = Replace(sFileFields, "---XFMR_SN---", vClient(1, 3))

sTmp = sFileHeader & sFileFields & sFileFooter

' Write FDF file to disk
If Len(vClient(1, 1)) Then sFileName = vClient(1, 1) Else sFileName = "FDF_DEMO"
sFileName = ActiveWorkbook.Path & "\" & sFileName & ".fdf"
lngFileNum = FreeFile
Open sFileName For Output As lngFileNum
Print #lngFileNum, sTmp
Close #lngFileNum
DoEvents

    ' Open FDF file as PDF
ShellExecute vbNull, "open", sFileName, vbNull, vbNull, SW_NORMAL
Exit Sub

ErrorHandler:
MsgBox "MakeFDF Error: " + Str(Err.Number) + " " + Err.Description + " " + Err.Source

End Sub

现在我在 Excell 中有一个用于输入数据的 UserForm，在该 UserForm 上是一个被编程为 RunApplication MakeFDF 的按钮。

您可以提供的任何帮助将不胜感激。

4

1 回答 1

1

如果您在工具/参考中勾选了正确的参考，那么大部分代码应该在 Access 中几乎未更改地运行。

Excel 特定项目是：

ActiveWorkbook.Path

Access 中的等价物是

Application.CurrentProject.Path

和这个：

vClient = Range(Selection.Row & ":" & Selection.Row)

我假设您将从 Access 表或表单上的文本框中读取哪些等效值。

于 2013-07-28T23:20:35.770 回答