0

この Visual Basic コードを MS Access で動作するように変換するのに助けが必要です。現在、フォームのデータを使用して PDF に入力するために MS Excel で使用しています。データベースを 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

これが2番目の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

アクセスで同等のものは

Application.CurrentProject.Path

この：

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

Access テーブルまたはフォームのテキスト ボックスのいずれかから読み取ると想定される同等の値。

于 2013-07-28T23:20:35.770 に答える