Programmatically Writing Code

[Deleted member 110146]

Hi Folks,

I was hoping someone might have had some experience with programmatically writing code at runtime. This is my first attempt at doing it, so it might be something quite simple I am missing.

What I am trying to do is cycle through all the controls on all the forms and draw a rectangle around all user controls to "highlight" mouseovers.
This part is all working, so I figured I would take it a step further(as you do) and write the mouseover code for each control while I am looping through the forms.

I am getting an error "Object does not support this method" on the red text. The blue highlighted text is where I intende to insert the code for the control. I have referenced the MS VBA Extensibility 5.3. Everthing I have read seems to point to this being the right format, but I just can't seem to sort it out.

Any Ideas would be greatly appreciated!

Sub FrameAllButtons()
    Dim objAccFrm As AccessObject
    Dim objCurrProj As Object
    Dim ctrl As Control
    Dim rectangle As Control
    Dim strTop, strLeft, strHeight, strWidth As String
    Dim code As String
    Dim boxname As String
    Dim frm As String
    Dim currentform As Form
    Dim sec As Sections
    Dim Procedure_Call As VBComponent
    
    
    
    Set objCurrProj = Application.CurrentProject
    
    
       
    For Each objAccFrm In objCurrProj.AllForms
        frm = objAccFrm.name
        If frm = "frmmenumain" Then
            DoCmd.OpenForm frm, acDesign
            Set currentform = Application.Screen.activeform
            [COLOR=red]Set Procedure_Call = objCurrProj.VBComponents(frm)[/COLOR][COLOR=#2e8b57]*Falling over here with Object does not support this property or method[/COLOR]
            [COLOR=teal]'Set Procedure_Call = objCurrProj.VBComponent(frm)
            'Set Procedure_Call = objCurrProj.VBComponents frm   ***Tried these as well***[/COLOR]
[COLOR=teal]            'Set Procedure_Call = objCurrProj.VBComponent frm[/COLOR]
[COLOR=red][COLOR=black]             For Each ctrl In currentform.Controls[/COLOR] [/COLOR]                    
                    
                    If ctrl.ControlType = ctrl.ControlType = acTextBox Or ctrl.ControlType = acOptionButton Or _
                        ctrl.ControlType = acComboBox Or ctrl.ControlType = acCheckBox Or ctrl.ControlType = acCommandButton Then
                        If ctrl.Visible = True Then
                            
                            If ctrl.Section = 0 Then
                                boxname = ctrl.name + "_Box"
                                strTop = ctrl.Top
                                strLeft = ctrl.Left
                                strHeight = ctrl.Height
                                strWidth = ctrl.Width
                                Set rectangle = CreateControl(frm, acRectangle, , , , strLeft, strTop, strWidth, strHeight)
                                rectangle.Visible = False
                                rectangle.name = boxname
                                rectangle.BorderStyle = 1
                                rectangle.BorderWidth = 1
                                rectangle.BorderColor = vbBlack
                                rectangle.SpecialEffect = 0
                                
                            ElseIf ctrl.Section = 2 Then
                                boxname = ctrl.name + "_Box"
                                strTop = ctrl.Top
                                strLeft = ctrl.Left
                                strHeight = ctrl.Height
                                strWidth = ctrl.Width
                                Set rectangle = CreateControl(frm, acRectangle, acFooter, , , strLeft, strTop, strWidth, strHeight)
                                rectangle.Visible = False
                                rectangle.name = boxname
                                rectangle.BorderStyle = 1
                                rectangle.BorderWidth = 1
                                rectangle.BorderColor = vbBlack
                                rectangle.SpecialEffect = 0
                                
                            End If
                            [COLOR=blue]Procedure_Call.codemodule.AddFromString (code)
                            code = "Public Sub " & ctrl.name & "_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)" & _
                            vbCr & vbCr & boxname & ".visible = true  'Code added by FrameAllControls Module" & vbCr & vbCr & "End Sub"[/COLOR]
                        End If
                    End If
                Next ctrl
           
            DoCmd.Close acForm, frm, acSaveNo
        End If
            Set ctrl = Nothing
            'boxnum = 1
      
    Next objAccFrm
    
End Sub

 

[MarkK]

Your objCurrProj is a datatype that does not expose a member called VBComponents.

 

[Deleted member 110146]

Thanks lagbolt, and although I was hoping for more than a rewording of the error I was receiving I poked around a little more and got the code to run...almost...

Now it will run through if I use a module name where the codename is...works exactly as planned, except the code is in a module and not in the current form where I need it.

*Amendment
I added some debug.print to view my count of lines and the name of the module and they both came out with the correct information. The proper module "Form_frmMenuMain" opens as well, but the code doesn't get written.


So I tried what you see below and it runs through to VBComp.CodeModule.AddFromString (code)
then the form just shuts down. I tried stepping through and I get an error that says "Can't enter break mode at this time", which means(in this case) that there was change programmatically in the code and the program cannot be suspended, but continuing just closes the form and stops the code.

Any ideas would be most appreciated!

'Cycles through all controls in all forms - wraps each control with a rectangle
Public Sub FrameAllButtons()
    Dim objAccFrm As AccessObject
    Dim objCurrProj As Object
    Dim ctrl As Control
    Dim rectangle As Control
    Dim strTop, strLeft, strHeight, strWidth As String
    Dim code As String
    Dim boxname As String
    Dim frm As String
    Dim currentform As Form
    Dim codename As String
    
    Dim VBAEditor As VBIDE.VBE
    Dim VBProj As VBIDE.VBProject
    Dim VBComp As VBIDE.VBComponent
    Dim CodeMod As VBIDE.CodeModule
 
    Set VBAEditor = Application.VBE
    Set VBProj = VBAEditor.ActiveVBProject
    
    
    Set objCurrProj = Application.CurrentProject
    
    
       
    For Each objAccFrm In objCurrProj.AllForms
        frm = objAccFrm.name
        codename = "FORM_" + frm
        If frm = "frmmenumain" Then
            DoCmd.OpenForm frm, acDesign
            Set currentform = Application.Screen.activeform
            Set VBComp = VBProj.VBComponents(codename)
            Set CodeMod = VBComp.CodeModule
           
                For Each ctrl In currentform.Controls
                    
                    
                    If ctrl.ControlType = ctrl.ControlType = acTextBox Or ctrl.ControlType = acOptionButton Or _
                        ctrl.ControlType = acComboBox Or ctrl.ControlType = acCheckBox Or ctrl.ControlType = acCommandButton And Not ctrl.name = "cmdFocus" Then
                        If ctrl.Visible = True Then
                            
                            If ctrl.Section = 0 Then
                                boxname = ctrl.name + "_Box"
                                strTop = ctrl.Top
                                strLeft = ctrl.Left
                                strHeight = ctrl.Height
                                strWidth = ctrl.Width
                                Set rectangle = CreateControl(frm, acRectangle, , , , strLeft, strTop, strWidth, strHeight)
                                rectangle.Visible = False
                                rectangle.name = boxname
                                rectangle.BorderStyle = 1
                                rectangle.BorderWidth = 1
                                rectangle.BorderColor = vbBlack
                                rectangle.SpecialEffect = 0
                                
                            ElseIf ctrl.Section = 2 Then
                                boxname = ctrl.name + "_Box"
                                strTop = ctrl.Top
                                strLeft = ctrl.Left
                                strHeight = ctrl.Height
                                strWidth = ctrl.Width
                                Set rectangle = CreateControl(frm, acRectangle, acFooter, , , strLeft, strTop, strWidth, strHeight)
                                rectangle.Visible = False
                                rectangle.name = boxname
                                rectangle.BorderStyle = 1
                                rectangle.BorderWidth = 1
                                rectangle.BorderColor = vbBlack
                                rectangle.SpecialEffect = 0
                                
                            End If
                            
                            code = "Private Sub " & ctrl.name & "_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)" & _
                            vbCr & vbCr & boxname & ".visible = true  'Code added by FrameAllControls Module" & vbCr & vbCr & "End Sub"
                            'VBComp.CodeModule.AddFromString (code)
                            With CodeMod
                                .InsertLines .CountOfLines + 1, code
                            End With
                            Debug.Print CodeMod.CountOfLines
                            Debug.Print CodeMod
                            
                                
                        End If
                    End If
                Next ctrl
           
            DoCmd.Close acForm, frm, acSaveYes
        End If
            Set ctrl = Nothing
            'boxnum = 1
      
    Next objAccFrm
    
End Sub