Access 2016 Switchboard将宏转换为VBA

时间:2018-07-07 05:38:54

标签: access-vba ms-access-2016

在Access 2016总机上,我将表格后面的宏转换为VBA,但无法编译。我发现一个临时解决方案是在 TempVars中添加 .Value 。添加“ CurrentItemNumber”,ItemNumber 并更改 Call Argument和“()”的两个实例调用Eval(Argument&“()”)。这样就解决了编译错误。

然后我向配电盘添加了另一个按钮“报告菜单”,但是当我单击新按钮时,出现此错误。

enter image description here

当我单击“调试”时,它将突出显示该行 TempVars。添加“ SwitchboardID”,参数。当我在该行末尾添加 .Value 时,在 TempVars.Add“ SwitchboardID”,Argument.Value 中,它解决了断点问题,新按钮可以使用,但是现在报表菜单填写不正确。

enter image description here

我可以单击“返回主菜单”以返回主菜单,除新的“报告菜单”按钮外,主菜单上的所有其他按钮都可以正常工作。

这是总机背后的代码...

    Option Compare Database

'------------------------------------------------------------
' Form_Current
'
'------------------------------------------------------------
Private Sub Form_Current()
On Error GoTo Form_Current_Err

  'TempVars.Add "CurrentItemNumber", ItemNumber
  TempVars.Add "CurrentItemNumber", ItemNumber.Value

Form_Current_Exit:
  Exit Sub

Form_Current_Err:
  MsgBox Error$
  Resume Form_Current_Exit

End Sub


'------------------------------------------------------------
' Form_Open
'
'------------------------------------------------------------
Private Sub Form_Open(Cancel As Integer)
On Error GoTo Form_Open_Err

  TempVars.Add "SwitchboardID", DLookup("SwitchboardID", "Switchboard Items", "[ItemNumber] = 0 AND [Argument] = 'Default'")
  DoCmd.SetProperty "Label1", acPropertyCaption, DLookup("ItemText", "Switchboard Items", "[SwitchboardID] = " & TempVars("SwitchboardID"))
  DoCmd.SetProperty "Label2", acPropertyCaption, DLookup("ItemText", "Switchboard Items", "[SwitchboardID] = " & TempVars("SwitchboardID"))
  DoCmd.Requery ""


Form_Open_Exit:
  Exit Sub

Form_Open_Err:
  MsgBox Error$
  Resume Form_Open_Exit

End Sub


'------------------------------------------------------------
' Option1_Click
'
'------------------------------------------------------------
Private Sub Option1_Click()
On Error GoTo Option1_Click_Err

  On Error GoTo 0
  If (Command = 1) Then
    'TempVars.Add "SwitchboardID", Argument
    TempVars.Add "SwitchboardID", Argument.Value
    DoCmd.SetProperty "Label1", acPropertyCaption, DLookup("ItemText", "Switchboard Items", "[SwitchboardID] = " & TempVars("SwitchboardID"))
    DoCmd.SetProperty "Label2", acPropertyCaption, DLookup("ItemText", "Switchboard Items", "[SwitchboardID] = " & TempVars("SwitchboardID"))
    DoCmd.Requery ""
    Exit Sub
  End If
  If (Command = 2) Then
    DoCmd.OpenForm Argument, acNormal, "", "", acAdd, acNormal
    Exit Sub
  End If
  If (Command = 3) Then
    DoCmd.OpenForm Argument, acNormal, "", "", , acNormal
    Exit Sub
  End If
  If (Command = 4) Then
    DoCmd.OpenReport Argument, acViewReport, "", "", acNormal
    Exit Sub
  End If
  If (Command = 5) Then
    DoCmd.RunCommand acCmdSwitchboardManager
    TempVars.Add "SwitchboardID", DLookup("SwitchboardID", "Switchboard Items", "[ItemNumber] = 0 AND [Argument] = 'Default'")
    DoCmd.SetProperty "Label1", acPropertyCaption, DLookup("ItemText", "Switchboard Items", "[SwitchboardID] = " & TempVars("SwitchboardID"))
    DoCmd.SetProperty "Label2", acPropertyCaption, DLookup("ItemText", "Switchboard Items", "[SwitchboardID] = " & TempVars("SwitchboardID"))
    DoCmd.Requery ""
    Exit Sub
  End If
  If (Command = 6) Then
    DoCmd.CloseDatabase
    Exit Sub
  End If
  If (Command = 7) Then
    DoCmd.RunMacro Argument, , ""
    Exit Sub
  End If
  If (Command = 8) Then
    'Call Argument & "()"
    Call Eval(Argument & "()")
    Exit Sub
  End If
  Beep
  MsgBox "Unknown option.", vbOKOnly, ""


Option1_Click_Exit:
  Exit Sub

Option1_Click_Err:
  MsgBox Error$
  Resume Option1_Click_Exit

End Sub


'------------------------------------------------------------
' OptionLabel1_Click
'
'------------------------------------------------------------
Private Sub OptionLabel1_Click()
On Error GoTo OptionLabel1_Click_Err

  On Error GoTo 0
  If (Command = 1) Then
    'TempVars.Add "SwitchboardID", Argument
    TempVars.Add "SwitchboardID", Argument.Value
    DoCmd.SetProperty "Label1", acPropertyCaption, DLookup("ItemText", "Switchboard Items", "[SwitchboardID] = " & TempVars("SwitchboardID"))
    DoCmd.SetProperty "Label2", acPropertyCaption, DLookup("ItemText", "Switchboard Items", "[SwitchboardID] = " & TempVars("SwitchboardID"))
    DoCmd.Requery ""
    Exit Sub
  End If
  If (Command = 2) Then
    DoCmd.OpenForm Argument, acNormal, "", "", acAdd, acNormal
    Exit Sub
  End If
  If (Command = 3) Then
    DoCmd.OpenForm Argument, acNormal, "", "", , acNormal
    Exit Sub
  End If
  If (Command = 4) Then
    DoCmd.OpenReport Argument, acViewReport, "", "", acNormal
    Exit Sub
  End If
  If (Command = 5) Then
    DoCmd.RunCommand acCmdSwitchboardManager
    TempVars.Add "SwitchboardID", DLookup("SwitchboardID", "Switchboard Items", "[ItemNumber] = 0 AND [Argument] = 'Default'")
    DoCmd.SetProperty "Label1", acPropertyCaption, DLookup("ItemText", "Switchboard Items", "[SwitchboardID] = " & TempVars("SwitchboardID"))
    DoCmd.SetProperty "Label2", acPropertyCaption, DLookup("ItemText", "Switchboard Items", "[SwitchboardID] = " & TempVars("SwitchboardID"))
    DoCmd.Requery ""
    Exit Sub
  End If
  If (Command = 6) Then
    DoCmd.CloseDatabase
    Exit Sub
  End If
  If (Command = 7) Then
    DoCmd.RunMacro Argument, , ""
    Exit Sub
  End If
  If (Command = 8) Then
    'Call Argument & "()"
    Call Eval(Argument & "()")
    Exit Sub
  End If
  Beep
  MsgBox "Unknown option.", vbOKOnly, ""


OptionLabel1_Click_Exit:
  Exit Sub

OptionLabel1_Click_Err:
  MsgBox Error$
  Resume OptionLabel1_Click_Exit

End Sub

任何建议将不胜感激。

谢谢。

3 个答案:

答案 0 :(得分:1)

在Access 365中,将Switchboard宏转换为VBA时似乎出现两个错误:一个在 On Current 事件过程中,一个在 On Open 事件过程中。 。错误消息仅指向打开时过程,而当前时事件过程似乎也需要更改。

当前:这会生成运行时错误32538“ TempVars只能存储数据。它们不能存储对象。”。 更改 TempVars。将“ CurrentItemNumber”,ItemNumber 添加到
TempVars。添加“ CurrentItemNumber”,ItemNumber.Value

打开时::这会生成编译错误。 将所有调用参数&“()” 的实例更改为评估(参数&“()”)。 尽管不是必需的,但是是一种良好的编码习惯,请将所有具有 Argument 的DoCmd语句更改为 Argument.Value

希望这会有所帮助。

答案 1 :(得分:0)

对您的代码的一些批评:

  1. Call Eval(Argument & "()")没有任何意义。 Call是多余的; Eval(Argument & "()")实际上是Argument中的函数名称。尝试使用Application.Run Me.Argument.Value
  2. 您应该在代码中完全指定所有控制值。示例:Me.Command.ValueMe.Argument.ValueMe.ItemNumber.Value
  3. 使用DoCmd.SetProperty "Label1", acPropertyCaption, "caption"代替Me.Lable1.Caption = "caption"
  4. 在每种情况下,都不需要使用与Lable2相同的DLookup函数来设置Label1。只需使用Me.Label2.Caption = Me.Label1.Caption
  5. TempVars.Add "SwitchboardID", Argument可能比TempVars("SwitchboardID") = Me.Argument.Value更干净

这将帮助您实现目标,但是我不能保证这可以解决您的问题。您将不得不使用传统的调试方法来找出可能出了什么问题并进行修复。

答案 2 :(得分:0)

我非常感谢您的答复,但是由于时间的限制,我投入了很多精力,试图修复由Access 2016生成的代码(当它转换宏时),并从工作正常的旧数据库的代码中抓取了Switchboard。我相信该代码是使用Access 2003创建的,但仍然可以完美运行(请参见下文),每个配电盘最多只能有8个按钮,但对于大多数应用程序来说应该足够了。

Option Compare Database

Private Sub Form_Open(Cancel As Integer)
' Minimize the database window and initialize the form.

' Move to the switchboard page that is marked as the default.
Me.Filter = "[ItemNumber] = 0 AND [Argument] = 'Default' "
Me.FilterOn = True

End Sub

Private Sub Form_Current()
' Update the caption and fill in the list of options.

Me.Caption = Nz(Me![ItemText], "")
FillOptions

End Sub

Private Sub FillOptions()
' Fill in the options for this switchboard page.

' The number of buttons on the form.
Const conNumButtons = 8

Dim con As Object
Dim RS As Object
Dim stSql As String
Dim intOption As Integer

' Set the focus to the first button on the form,
' and then hide all of the buttons on the form
' but the first.  You can't hide the field with the focus.
Me![Option1].SetFocus
For intOption = 2 To conNumButtons
    Me("Option" & intOption).Visible = False
    Me("OptionLabel" & intOption).Visible = False
Next intOption

' Open the table of Switchboard Items, and find
' the first item for this Switchboard Page.
Set con = Application.CurrentProject.Connection
stSql = "SELECT * FROM [Switchboard Items]"
stSql = stSql & " WHERE [ItemNumber] > 0 AND [SwitchboardID]=" & Me![SwitchboardID]
stSql = stSql & " ORDER BY [ItemNumber];"
Set RS = CreateObject("ADODB.Recordset")
RS.Open stSql, con, 1   ' 1 = adOpenKeyset

' If there are no options for this Switchboard Page,
' display a message.  Otherwise, fill the page with the items.
If (RS.EOF) Then
    Me![OptionLabel1].Caption = "There are no items for this switchboard page"
Else
    While (Not (RS.EOF))
        Me("Option" & RS![ItemNumber]).Visible = True
        Me("OptionLabel" & RS![ItemNumber]).Visible = True
        Me("OptionLabel" & RS![ItemNumber]).Caption = RS![ItemText]
        RS.MoveNext
    Wend
End If

' Close the recordset and the database.
RS.Close
Set RS = Nothing
Set con = Nothing

End Sub

Private Function HandleButtonClick(intBtn As Integer)
' This function is called when a button is clicked.
' intBtn indicates which button was clicked.

' Constants for the commands that can be executed.
Const conCmdGotoSwitchboard = 1
Const conCmdOpenFormAdd = 2
Const conCmdOpenFormBrowse = 3
Const conCmdOpenReport = 4
Const conCmdCustomizeSwitchboard = 5
Const conCmdExitApplication = 6
Const conCmdRunMacro = 7
Const conCmdRunCode = 8
Const conCmdOpenPage = 9

' An error that is special cased.
Const conErrDoCmdCancelled = 2501

Dim con As Object
Dim RS As Object
Dim stSql As String

On Error GoTo HandleButtonClick_Err

' Find the item in the Switchboard Items table
' that corresponds to the button that was clicked.
Set con = Application.CurrentProject.Connection
Set RS = CreateObject("ADODB.Recordset")
stSql = "SELECT * FROM [Switchboard Items] "
stSql = stSql & "WHERE [SwitchboardID]=" & Me![SwitchboardID] & " AND [ItemNumber]=" & intBtn
RS.Open stSql, con, 1    ' 1 = adOpenKeyset

' If no item matches, report the error and exit the function.
If (RS.EOF) Then
    MsgBox "There was an error reading the Switchboard Items table."
    RS.Close
    Set RS = Nothing
    Set con = Nothing
    Exit Function
End If

Select Case RS![Command]

    ' Go to another switchboard.
    Case conCmdGotoSwitchboard
        Me.Filter = "[ItemNumber] = 0 AND [SwitchboardID]=" & RS![Argument]

    ' Open a form in Add mode.
    Case conCmdOpenFormAdd
        DoCmd.OpenForm RS![Argument], , , , acAdd

    ' Open a form.
    Case conCmdOpenFormBrowse
        DoCmd.OpenForm RS![Argument]

    ' Open a report.
    Case conCmdOpenReport
        DoCmd.OpenReport RS![Argument], acPreview

    ' Customize the Switchboard.
    Case conCmdCustomizeSwitchboard
        ' Handle the case where the Switchboard Manager
        ' is not installed (e.g. Minimal Install).
        On Error Resume Next
        Application.Run "ACWZMAIN.sbm_Entry"
        If (Err <> 0) Then MsgBox "Command not available."
        On Error GoTo 0
        ' Update the form.
        Me.Filter = "[ItemNumber] = 0 AND [Argument] = 'Default' "
        Me.Caption = Nz(Me![ItemText], "")
        FillOptions

    ' Exit the application.
    Case conCmdExitApplication
        CloseCurrentDatabase

    ' Run a macro.
    Case conCmdRunMacro
        DoCmd.RunMacro RS![Argument]

    ' Run code.
    Case conCmdRunCode
        Application.Run RS![Argument]

    ' Open a Data Access Page
    Case conCmdOpenPage
        DoCmd.OpenDataAccessPage RS![Argument]

    ' Any other command is unrecognized.
    Case Else
        MsgBox "Unknown option."

End Select

' Close the recordset and the database.
RS.Close

HandleButtonClick_Exit:
On Error Resume Next
Set RS = Nothing
Set con = Nothing
Exit Function

HandleButtonClick_Err:
' If the action was cancelled by the user for
' some reason, don't display an error message.
' Instead, resume on the next line.
If (Err = conErrDoCmdCancelled) Then
    Resume Next
Else
    MsgBox "There was an error executing the command.", vbCritical
    Resume HandleButtonClick_Exit
End If

End Function

希望这可以帮助其他人...