Selasa, 21 Maret 2017

[MS_AccessPros] Converting Macros to VBA Question

 

Hello all,


I am trying to rid one of my databases of all macros. But I have come across a macro that runs another macro that has some if statements  in both of the macros. I am not sure if when I converted the macros and then combined them if it is correct. There are 2 End With statements and they seem similar. I took the database over and I am not sure why a macro is running a macro that does something similar. could anyone look at the code and see if I have it correct?


Thank You

Jim Wagner


here is the main macro

'------------------------------------------------------------
' mcro_SetValueStatusToDELETE
'
'------------------------------------------------------------
Function SetValueStatusToDELETE()
On Error GoTo SetValueStatusToDELETE_Err

    With CodeContextObject
        DoCmd.SetWarnings False
        If (.ACTION = "DELETED") Then
            .status = "Deleted"
        End If
       
         With CodeContextObject
        If (.ACTION = "RECLASS") Then
            .CurrentJobTitle.Visible = True
        End If
        If (.ACTION = "RECLASS") Then
            .CurrentJobCode.Visible = True
        End If
        If (.ACTION <> "RECLASS") Then
            .CurrentJobTitle.Visible = False
        End If
        If (.ACTION <> "RECLASS") Then
            .CurrentJobCode.Visible = False
        End If
    End With
       
       
        'DoCmd.RunMacro "mcro_OpenCurrentTitleAndJobCodeFieldsOnReclass", , ""
        DoCmd.SetWarnings True
    End With


SetValueStatusToDELETE_Exit:
    Exit Function


SetValueStatusToDELETE_Err:
    MsgBox Error$
    Resume SetValueStatusToDELETE_Exit

End Function







Here is the macro in the macro


'------------------------------------------------------------
' mcro_OpenCurrentTitleAndJobCodeFieldsOnReclass
'
'------------------------------------------------------------
Function mcro_OpenCurrentTitleAndJobCodeFieldsOnReclass()
On Error GoTo mcro_OpenCurrentTitleAndJobCodeFieldsOnReclass_Err

    With CodeContextObject
        If (.ACTION = "RECLASS") Then
            .CurrentJobTitle.Visible = True
        End If
        If (.ACTION = "RECLASS") Then
            .CurrentJobCode.Visible = True
        End If
        If (.ACTION <> "RECLASS") Then
            .CurrentJobTitle.Visible = False
        End If
        If (.ACTION <> "RECLASS") Then
            .CurrentJobCode.Visible = False
        End If
    End With


mcro_OpenCurrentTitleAndJobCodeFieldsOnReclass_Exit:
    Exit Function

mcro_OpenCurrentTitleAndJobCodeFieldsOnReclass_Err:
    MsgBox Error$
    Resume mcro_OpenCurrentTitleAndJobCodeFieldsOnReclass_Exit

End Function




Here is the combined code


'------------------------------------------------------------
' Combined Macros
'
'------------------------------------------------------------
Function SetValueStatusToDELETE()
On Error GoTo SetValueStatusToDELETE_Err

    With CodeContextObject
        DoCmd.SetWarnings False
        If (.ACTION = "DELETED") Then
            .status = "Deleted"
        End If
       
         With CodeContextObject
        If (.ACTION = "RECLASS") Then
            .CurrentJobTitle.Visible = True
        End If
        If (.ACTION = "RECLASS") Then
            .CurrentJobCode.Visible = True
        End If
        If (.ACTION <> "RECLASS") Then
            .CurrentJobTitle.Visible = False
        End If
        If (.ACTION <> "RECLASS") Then
            .CurrentJobCode.Visible = False
        End If
    End With
       
       
        With CodeContextObject
        If (.ACTION = "RECLASS") Then
            .CurrentJobTitle.Visible = True
        End If
        If (.ACTION = "RECLASS") Then
            .CurrentJobCode.Visible = True
        End If
        If (.ACTION <> "RECLASS") Then
            .CurrentJobTitle.Visible = False
        End If
        If (.ACTION <> "RECLASS") Then
            .CurrentJobCode.Visible = False
        End If
    End With

        DoCmd.SetWarnings True
    End With


SetValueStatusToDELETE_Exit:
    Exit Function

SetValueStatusToDELETE_Err:
    MsgBox Error$
    Resume SetValueStatusToDELETE_Exit

End Function


__._,_.___

Posted by: luvmymelody@yahoo.com
Reply via web post Reply to sender Reply to group Start a New Topic Messages in this topic (1)

Have you tried the highest rated email app?
With 4.5 stars in iTunes, the Yahoo Mail app is the highest rated email app on the market. What are you waiting for? Now you can access all your inboxes (Gmail, Outlook, AOL and more) in one place. Never delete an email again with 1000GB of free cloud storage.


.

__,_._,___

Tidak ada komentar:

Posting Komentar