Re: [MS_AccessPros] Converting Macros to VBA Question

 

Jim-

That's not substantially different.  It still needs to be cleaned up like this:

Function SetValueStatusToDELETE() 
On Error GoTo SetValueStatusToDELETE_Err 

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

     DoCmd.SetWarnings True 

SetValueStatusToDELETE_Exit: 
    Exit Function 

SetValueStatusToDELETE_Err: 
    MsgBox Error$ 
    Resume SetValueStatusToDELETE_Exit 

End Function 

John Viescas, Author

Effective SQL

SQL Queries for Mere Mortals 

Microsoft Access 2010 Inside Out

Microsoft Access 2007 Inside Out

Microsoft Access 2003 Inside Out

Building Microsoft Access Applications 

http://www.viescas.com/ 

(Paris, France)

On Mar 21, 2017, at 9:35 PM, Jim Wagner luvmymelody@yahoo.com [MS_Access_Professionals] <MS_Access_Professionals@yahoogroups.com> wrote:

sorry I copied it wrong

'------------------------------------------------------------ 
' 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 
         
       

        DoCmd.SetWarnings True 
    End With 


SetValueStatusToDELETE_Exit: 
    Exit Function 

SetValueStatusToDELETE_Err: 
    MsgBox Error$ 
    Resume SetValueStatusToDELETE_Exit 

End Function 

Jim Wagner

---

On ‎Tuesday‎, ‎March‎ ‎21‎, ‎2017‎ ‎06‎:‎15‎:‎51‎ ‎AM, John Viescas JohnV@msn.com [MS_Access_Professionals] <MS_Access_Professionals@yahoogroups.com> wrote:

Jim-

It looks like the code conversion has embedded the second macro in the first.  It needs to be cleaned up:

Function SetValueStatusToDELETE()
On Error GoTo SetValueStatusToDELETE_Err

    With CodeContextObject

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

    Exit Function

SetValueStatusToDELETE_Err:

    MsgBox Error$
    Resume SetValueStatusToDELETE_Exit

End Function

You don't need the second function.

John Viescas, Author

Effective SQL

SQL Queries for Mere Mortals 

Microsoft Access 2010 Inside Out

Microsoft Access 2007 Inside Out

Microsoft Access 2003 Inside Out

Building Microsoft Access Applications 

http://www.viescas.com/ 

(Paris, France)

On Mar 21, 2017, at 8:22 PM, luvmymelody@yahoo.com [MS_Access_Professionals] <MS_Access_Professionals@yahoogroups.com> wrote:

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: John Viescas <johnv@msn.com>

---

Reply via web post

•

Reply to sender

•

Reply to group

•

Start a New Topic

•

Messages in this topic (4)

---

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.

---

Visit Your Group

• New Members 1

• Privacy • Unsubscribe • Terms of Use

.

__,_._,___