I am doing a PPT where I need to click buttons to show various Forms.
I have created a public function in the main module.
Public Function ShowForm(FormName As String)
Dim oneForm As Object
For Each oneForm In UserForms
If oneForm.Name = FormName Then
oneForm.Show
End
End If
Next oneForm
End Function
And used it in the button below:
Private Sub NextPage_Click()
ShowForm ("SU0" & qlist(cntr))
cntr = cntr + 1
End Sub
But the function does not work. Did I miss anything or is there a better way of doing this?
Solved
Google is the key...
I have changed the function in the module and everything works fine now.
Public Function ShowForm(FormName As String)
Dim oneForm As Object
Set oneForm = CallByName(UserForms, "Add", VbMethod, FormName)
oneForm.Show
End Function
Note that in order to handle multiple userforms, the "ShowModal" property of those forms needs to be set to FALSE.
Related
Hej,
I am trying to design a code, where a number of commandbuttons call the same userform. I have created the class module and got it to work so that they all call the userform, but I need the name of the button passed on from the class module into the userform initialize. I have tried it with property get and a public function, but can't get it to work. The variable I want to pass is the "ScreenShotCap" as string Anyone, who can help?
CLASS MODULE CODE
Option Explicit
Public ScreenShotCap As String
Public WithEvents CmdBtn As MSForms.CommandButton
Property Set obj(btns As MSForms.CommandButton)
'Defines the property of the object called
Set CmdBtn = btns
End Property
Private Sub CmdBtn_Click()
'Gets the button caption
ScreenShotCap = CmdBtn.Name
'Loads the userform
ufScreenshot.Show
End Sub
USERFORM CODE
Private Sub UserForm_Initialize()
Dim btnNo As Variant
Dim imNo1, imNo2, imNo3 As Integer
'Gets the number of the button
btnNo = Right(ScreenShotCap, 1)
'Sets the image number
imNo1 = Int(btnNo + 2)
imNo2 = Int(btnNo + 3)
imNo3 = Int(btnNo + 4)
'Loads the image from MSForms into userform
If ScreenShotCap = Worksheets("SW_TEST").OLEObjects("CommandButton1").Name Then
Application.ScreenUpdating = False
Me.Image1.Picture = Worksheets("SW_TEST").OLEObjects("Image1").Object.Picture
Me.Image2.Picture = Worksheets("SW_TEST").OLEObjects("Image2").Object.Picture
Me.Image3.Picture = Worksheets("SW_TEST").OLEObjects("Image3").Object.Picture
Application.ScreenUpdating = True
Else
Application.ScreenUpdating = False
Me.Image1.Picture = Worksheets("SW_TEST").OLEObjects("Image" & imNo1).Object.Picture
Me.Image2.Picture = Worksheets("SW_TEST").OLEObjects("Image" & imNo2).Object.Picture
Me.Image3.Picture = Worksheets("SW_TEST").OLEObjects("Image" & imNo3).Object.Picture
'after any change vba has to be told to refresh the UserForm for the change to appear
Me.Repaint
Application.ScreenUpdating = True
End If
End Sub
Move the codes in UserForm_Initialize() to a new sub with a parameter or just rename it to:
Public Sub LoadButtonImage(ScreenShotCap As String)
Then in your CmdBtn_Click() sub:
Load ufScreenshot.Show
ufScreenshot.LoadButtonImage CmdBtn.Name
uScreenshot.Show
Once the button is pressed it does not perform the subroutine defined OnAction method.
I have checked all the Security options in Access are enabled and have written the same code in different ways.
I have tried to run a function with the OnAction method instead.
Private Sub Check_Status_Click()
Dim cmdBAR As CommandBar
Dim cmdButton1 As CommandBarButton
Set cmdBAR = CommandBars.Add(, msoBarPopup, False, True)
Set cmdButton1 = cmdBAR.Controls.Add(msoControlButton)
cmdButton1.Caption = "Dale"
cmdButton1.OnAction = "Dale"
cmdBAR.ShowPopup
'Clean
Set cmdBAR = Nothing
Set cmdButton1 = Nothing
End Sub
Public Sub Dale()
MsgBox "hola"
End Sub
I dont get any error, just it is not doing anything even the menu shows up.
Actually OnAction subroutine needs to be
public sub
in public module
So you should change your code to something like this:
...
cmdButton1.Caption = "Dale"
cmdButton1.OnAction = "Dale"
cmdBAR.ShowPopup
...
And place your sub into some public module:
Public Sub Dale()
MsgBox "hola"
End Sub
I'm familiar with passing an argument to a procedure by reference. Alternately, ParamArray allows me the flexibility of passing 0 or more arguments to a procedure by reference as well. However, that approach made me wonder if there was a way to preserve a reference to one or more variables beyond the scope of a procedure. My first glimmer of hope was the VBA Array function when I saw it was declared like this:
Array(ParamArray ArgList() As Variant)
So, I put together the following test code:
Private Sub Test()
Dim a As Object
Dim b() As Variant
ParamArrayTest a
Debug.Print TypeName(a) ' Output is 'Dictionary'
b = Array(a) ' b should be like ParamArray ArgList()
Set b(0) = Nothing ' This should clear a
Debug.Print TypeName(a) ' Output is still 'Dictionary'
End Sub
Private Sub ParamArrayTest(ParamArray ArgList() As Variant)
Set ArgList(0) = CreateObject("Scripting.Dictionary")
End Sub
Unfortunately, this did not work as I expected. Despite the argument being passed into the Array function via ParamArray, it would appear that the returned array was by value and not by reference.
Further research led me to the undocumented VBA VarPtr / StrPtr / ObjPtr functions. I found numerous examples of using them in conjunction with the API RtlMoveMemory function. However, all of the articles I read strongly urged against using that approach since it could very easily crash the application. Some of my testing did indeed crash Access.
Another idea I had was to see if I could directly assign a reference of one variable to another:
Private Sub Test()
Dim a As Object
Dim b As Variant
b = ByRef a ' Throws a compiler error
End Sub
Suffice it to say, the compiler simply would not allow that. My question then is, can a variable reference be safely stored / preserved beyond the scope of a procedure (preferably in another variable)?
EDIT
I decided it would be more helpful if I shed some light on what I'm trying to build.
I'm currently in the process of creating a wrapper class which will pass all form / control events to a procedure in one of my modules. It will be used with 2 forms which have the same control structure but connect to different source tables. Bear in mind that the code is incomplete but should be sufficient to illustrate the problem I'm trying to overcome. Also, Database is my VBA project name.
There are four portions to the code:
Form_TEST_FORM - Form Module
Private Sub Form_Open(Cancel As Integer)
FormHub.InitForm Me, Cancel
End Sub
FormHub - Module
Public Sub InitForm( _
ByRef Form As Access.Form, _
ByRef Cancel As Integer _
)
Dim Evt As Database.EventHandler
Set Evt = New Database.EventHandler
Evt.InitFormObject Form, Cancel
FormList.Add Evt, Form.Name
End Sub
Private Function FormList() As VBA.Collection
Static Init As Boolean
Static Coll As VBA.Collection
If Not Init Then
Set Coll = New VBA.Collection
Init = True
End If
Set FormList = Coll
End Function
FormControl - Class Module
Public Ptr As Variant ' Pointer to form control variable
Public acType As Access.AcControlType
EventHandler - Class Module
Private WithEvents Form As Access.Form
Private WithEvents SForm As Access.SubForm
Private CtrlList As VBA.Collection
Private Sub Class_Initialize()
InitCtrlList
End Sub
Public Sub InitFormObject(FormObj As Access.Form, ByRef Cancel As Integer)
Dim ErrFlag As Boolean
Dim Ctrl As Access.Control
Dim FCtrl As Database.FormControl
On Error GoTo Proc_Err
Set Form = FormObj
If Form.Controls.Count <> CtrlList.Count Then
Err.Raise 1, , _
"Form has incorrect number of controls"
End If
' This is where I want to validate the form controls
' and also initialize my event variables.
For Each Ctrl In Form.Controls
If Not CtrlExists(FCtrl, Ctrl.Name) Then
Err.Raise 2, , _
"Invalid control name"
ElseIf FCtrl.acType <> Ctrl.ControlType Then
Err.Raise 3, , _
"Invalid control type"
Else
' Initialize the correct variable with it's
' pointer. This is the part I haven't been
' able to figure out yet.
Set FCtrl.Ptr = Ctrl
End If
Next
Proc_End:
On Error Resume Next
If ErrFlag Then
ClearEventVariables
End If
Set Ctrl = Nothing
Set FCtrl = Nothing
Exit Sub
Proc_Err:
ErrFlag = True
Debug.Print "InitFormObject " & _
"Error " & Err & ": " & Err.Description
Resume Proc_End
End Sub
Private Function CtrlExists( _
ByRef FCtrl As Database.FormControl, _
ByRef CtrlName As String _
) As Boolean
On Error Resume Next
Set FCtrl = CtrlList(CtrlName)
CtrlExists = Err = 0
End Function
Private Sub InitCtrlList()
Set CtrlList = New VBA.Collection
CtrlList.Add SetCtrlData(SForm, acSubform), "SForm"
End Sub
Private Function SetCtrlData( _
ByRef Ctrl As Access.Control, _
ByRef acType As Access.AcControlType _
) As Database.FormControl
Set SetCtrlData = New Database.FormControl
With SetCtrlData
' This assignment is where I need to keep a reference
' to the variable in the class. However, it doesn't
' work.
Set .Ptr = Ctrl
.acType = acType
End With
End Function
Private Sub ClearEventVariables()
Dim FormCtrl As Database.FormControl
Set Form = Nothing
For Each FormCtrl In CtrlList
' Assuming I was able to retain a reference to the
' class variable, this would clear it.
Set FormCtrl.Ptr = Nothing
Next
End Sub
Private Sub Class_Terminate()
ClearEventVariables
Set CtrlList = Nothing
End Sub
I only used 1 control in the code example for simplicity sake. But, the idea is to simplify how much code I would need to modify in order to add / remove controls should the form design change. Or, in the event I have to add more forms to the project.
If you need to reference only within a single module, declare as Public in module header. If you want to reference in any module, declare as Global in a general module header. Even array and recordset and connection objects can be declared this way. Be aware these variables will lose their values if code breaks in runtime.
Or look into TempVar object variables. They don't lose values if code breaks. But can only store number or text values, not objects.
I have a couple of forms (i.e. frmTest) with bound comboboxes (i.e. cboTest). I'm trying to solve the NotInList event by a public sub, which calls back a button click sub's in these forms (i.e. btnTest_Click).
Form frmTest:
Private Sub cboTest_NotInList(NewData As String, Response As Integer)
Response = acDataErrContinue
Item_NotInList NewData, Me, "btnTest"
End Sub
Public Sub btnTest_Click
'....
End sub
Module:
Public strNotInList_Text As String
'public variable to store entered text
Public Sub Item_NotInList (strNewData As string, frmForm As Form, strControl As String)
Dim strControl_Sub As String
strNotInList_Text = strNewData
strControl_Sub = "." & strControl & "_Click"
Application.Run frmForm.Name & strControl_Sub
End Sub
Acces returns an error "Program ... didn't found a procedure frmTest.btnTest_Click."
Why ?
Reference frmTest.btnTest_Click looks to be correct. Sub btnTest_Click is declared as public.
Thank you for yor help.
Couldn't you create an interface let say IMyInterface with this method btnTest_Click (should be named differently) and let the forms you want to call this method implement this interface. Then change the signature of Item_NotInList like this:
Public Sub Item_NotInList (strNewData As string, frmForm As IMyInterface, strControl As String)
' ...
frmForm.btnTest_Click
' ...
Because the instance of the form is available in the method Item_NotInList you simply call the target method. Does this help?
Example:
Add class module and name it e.g. IMyInterface (can be named according to your needs). Add empty body of the method (don't add any implementation).
IMyInterface
Public Sub TestClick()
' will be implemented in your forms
End Sub
Then implement this interface in your forms e.g. in Form frmTest and others which should be used with the Item_NotInList method.
Form frmTest example
Implements IMyInterface
Private Sub IMyInterface_TestClick()
' here goes your implementation
End Sub
Standard Module test code
Sub test()
Dim f1 As UserForm1
Set f1 = New UserForm1
Item_NotInList f1
Dim f2 As UserForm2
Set f2 = New UserForm2
Item_NotInList f2
End Sub
Sub Item_NotInList(testForm As IMyInterface)
testForm.TestClick
End Sub
Thats it. HTH
I've spent 2 days now trying and searching and nothing seems to be working...
I created a custom ribbon Add-In for Visio in VSTO that installs and buttons work fine. I just recently added a couple of checkboxes to the ribbon whose states I want to read from within a VBA project.
I can't for the life of me figure out how to access the checkbox state in VBA. I tried a bunch of things with CommandBars and ToolBars but got nowhere and then I found this walkthrough which seemed promising and followed it to make the Add-In's methods visible to VBA: https://msdn.microsoft.com/en-us/library/bb608614
The VBA code does recognize the add-in and I assign the add-in object but when I try to call the object's function (getIOPressedState which refers to the state of one of the checkboxes), I get "object doesn't support this property or method".
Am I missing something here??
This is my ribbon class I want to make visible
<ComVisible(True)> _
Public Interface IAddInUtilities
Function getIOPressed() As Boolean
Function getDDPressed() As Boolean
Sub doNothing()
End Interface
<Runtime.InteropServices.ComVisible(True)> _
<ClassInterface(ClassInterfaceType.None)> _
Public Class StructuredAnalysisRibbon
Implements Office.IRibbonExtensibility, IAddInUtilities
Public ioPressedState As Boolean = False
Public ddPressedState As Boolean = False
Public ribbon As Office.IRibbonUI
Public Function GetCustomUI(ByVal ribbonID As String) As String Implements Office.IRibbonExtensibility.GetCustomUI
Return getResourceText("SAVisioAddIn.StructuredAnalysisRibbon.xml")
End Function
Public Function getIOPressed() As Boolean Implements IAddInUtilities.getIOPressed
Return ioPressedState
End Function
Public Function getDDPressed() As Boolean Implements IAddInUtilities.getDDPressed
Return ddPressedState
End Function
Public Sub doNothing() Implements IAddInUtilities.doNothing
'do nothing-added this to see if function As boolean in interface was causing issues
End Sub
ThisAddIn.vb
Public SARibbon As StructuredAnalysisRibbon
Protected Overrides Function CreateRibbonExtensibilityObject() As Microsoft.Office.Core.IRibbonExtensibility
Return SARibbon
End Function
Protected Overrides Function RequestComAddInAutomationService() As Object
If SARibbon Is Nothing Then
SARibbon = New StructuredAnalysisRibbon
End If
Return SARibbon
End Function
Visio VBA Code
Public Sub bloop()
Dim addIn As COMAddIn
Dim addInObject As Object
Dim ioPressed As Boolean
ioPressed = False
Set addIn = Application.COMAddIns.Item("SAVisioAddIn")
Set addInObject = addIn.Object
ioPressed = addInObject.getIOPressed 'fails here bc method not recognized for object
'Also tried addIn.Object.doNothing and still didn't work
If ioPressed = True Then
MsgBox "checked"
Else
MsgBox "not checked"
End If
End Sub
I think the problem has nothing to do with checkboxes, the point is VBA by default returns you the default object interface (which in your code is NOT the IAddInUtilities). Just swap the interfaces. The IAddInUtilities should be default (first). Or remove IAddInUtilities at all, along with fancy COM stuff like ClassInterface(ClassInterfaceType.None) which is considered harmful :) Anyways, the easiest may be:
Implements IAddInUtilities, Office.IRibbonExtensibility