How to Access Custom Add-In Ribbon Check Box in VBA? - vba

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

Related

Show VBA userform with variables in userform name

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.

Sub function to show UserForm

I have an excel file with multiple UserForms. To open a UserForm I have code such as
Sub runAdjuster()
Adjuster.Show
End Sub
There are about 5 of these. What is considered best practice in terms of where this code should be kept? I originally had it in a module, but have decided to move it to the ThisWorkbook object. Looking for tips on what is normally done to keep code clean.
Assuming Adjuster is the name of the form, you're using the default instance here, which isn't ideal.
This would already be better:
Dim view As Adjuster
Set view = New Adjuster
view.Show
Yes, it's more code. But you're using a dedicated object (i.e. view) and, if that object's state gets modified, these changes aren't going to affect the default instance. Think of that default instance as a global object: it's global, which isn't very OOP.
Now, you may argue, why not "new up" the object on the same line as the declaration then?
Consider this:
Sub DoSomething()
Dim c As New Collection
Set c = Nothing
c.Add "test"
End Sub
Is this code accessing a null reference and blowing up with a run-time error 91? No! Confusing? Yes! Hence, avoid the As New shortcut, unless you like having VBA automagically doing implicit stuff behind your back.
So, you're asking about best practice... I tend to consider VBA UserForms as an early pre-.NET version of winforms, and best practice design pattern for WinForms is the Model-View-Presenter pattern (aka "MVP").
Following this pattern, you'll have UserForms strictly responsible for presentation, and you'll have your business logic either implemented in a presenter object, or in a dedicated object that the presenter uses. Something like this:
Class Module: MyPresenter
The presenter class receives events from the model, and executes application logic depending on the state of the model. It knows about a concept of a view, but it doesn't have to be tightly coupled with a concrete implementation (e.g. MyUserForm) - with proper tooling you could write unit tests to validate your logic programmatically, without having to actually run the code and display the form and click everywhere.
Option Explicit
Private Type TPresenter
View As IView
End type
Public Enum PresenterError
ERR_ModelNotSet = vbObjectError + 42
End Enum
Private WithEvents viewModel As MyModel
Private this As TPresenter
Public Sub Show()
If viewModel Is Nothing Then
Err.Raise ERR_ModelNotSet, "MyPresenter.Show", "Model is not set to an object reference."
End If
'todo: set up model properties
view.Show
If Not view.IsCancelled Then DoSomething
End Sub
Public Property Get View() As IView
Set View = this.View
End Property
Public Property Set View(ByVal value As IView)
Set this.View = value
If Not this.View Is Nothing Then Set this.View.Model = viewModel
End Property
Public Property Get Model() As MyModel
Set Model = viewModel
End Property
Public Property Set Model(ByVal value As MyModel)
Set viewModel = value
If Not this.View Is Nothing Then Set this.View.Model = viewModel
End Property
Private Sub Class_Terminate()
Set this.View.Model = Nothing
Set this.View = Nothing
Set viewModel = Nothing
End Sub
Private Sub viewModel_PropertyChanged(ByVal changedProperty As ModelProperties)
'todo: execute logic that needs to run when something changes in the form
End Sub
Private Sub DoSomething()
'todo: whatever needs to happen after the form closes
End Sub
Class Module: IView
That's the abstraction that represents the concept of a View that exposes everything the Presenter needs to know about any UserForm - note that everything it needs to know, isn't much:
Option Explicit
Public Property Get Model() As Object
End Property
Public Property Set Model(ByVal value As Object)
End Property
Public Property Get IsCancelled() As Boolean
End Property
Public Sub Show()
End Sub
Class Module: MyModel
The model class encapsulates the data that the form needs and manipulates. It doesn't know about the view, and it doesn't know about the presenter either: it's just a container for encapsulated data, with simple logic that enables both the view and the presenter to execute code when any of the properties are modified.
Option Explicit
Private Type TModel
MyProperty As String
SomeOtherProperty As String
'todo: wrap members here
End Type
Public Enum ModelProperties
MyProperty
SomeOtherProperty
'todo: add enum values here for each monitored property
End Enum
Public Event PropertyChanged(ByVal changedProperty As ModelProperties)
Private this As TModel
Public Property Get MyProperty() As String
MyProperty = this.MyProperty
End Property
Public Property Let MyProperty(ByVal value As String)
If this.MyProperty <> value Then
this.MyProperty = value
RaiseEvent PropertyChanged(MyProperty)
End If
End Property
Public Property Get SomeOtherProperty() As String
SomeProperty = this.SomeOtherProperty
End Property
Public Property Let SomeOtherProperty(ByVal value As String)
If this.SomeOtherProperty <> value Then
this.SomeOtherProperty = value
RaiseEvent PropertyChanged(SomeOtherProperty)
End If
End Property
'todo: expose other model properties
UserForm: MyUserForm
The UserForm is strictly responsible for visual presentation; all its event handlers to, is change the value of a property in the model - the model then tells the presenter "hey I've been modified!", and the presenter acts accordingly. The form also listens for modified properties on the model, so when the presenter changes the model, the view can execute code and update itself accordingly. Here's an example of a simple form "binding" the MyProperty model property to the text of some TextBox1; I added a listener for SomeOtherProperty just to illustrate that the view can also be updated indirectly when the model changes.
Obviously the view wouldn't be reacting to the same properties changing as the presenter, otherwise you would enter an endless ping-pong of callbacks that would eventually blow up the stack... but you get the idea.
Note that the form implements the IView interface, so that the presenter can talk to it without actually knowing about its inner workings. The interface implementation simply refers to concrete members, but the concrete members don't even need to actually exist, since they won't even be used!
Option Explicit
Implements IView
Private Type TView
IsCancelled As Boolean
End Type
Private WithEvents viewModel As MyModel
Private this As TView
Private Property Get IView_Model() As Object
Set IView_Model = Model
End Property
Private Property Set IView_Model(ByVal value As Object)
Set Model = value
End Property
Private Property Get IView_IsCancelled() As Boolean
IView_IsCancelled = IsCancelled
End Property
Private Sub IView_Show()
Show vbModal
End Sub
Public Property Get Model() As MyModel
Set Model = viewModel
End Property
Public Property Set Model(ByVal value As MyModel)
Set viewModel = value
End Property
Public Property Get IsCancelled() As Boolean
IsCancelled = this.IsCancelled
End Property
Private Sub CancelButton_Click()
this.IsCancelled = True
Me.Hide
End Sub
Private Sub OkButton_Click()
Me.Hide
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
'"x-ing out" of the form is like clicking the Cancel button
If CloseMode = VbQueryClose.vbFormControlMenu Then
this.IsCancelled = True
End If
End Sub
Private Sub UserForm_Activate()
If viewModel Is Nothing Then
MsgBox "Model property must be assigned before the view can be displayed.", vbCritical, "Error"
Unload Me
Else
Me.TextBox1.Text = viewModel.MyProperty
Me.TextBox1.SetFocus
End If
End Sub
Private Sub TextBox1_Change()
'UI elements update the model properties
viewModel.MyProperty = Me.TextBox1.Text
End Sub
Private Sub viewModel_PropertyChanged(ByVal changedProperty As ModelProperties)
If changedProperty = SomeOtherProperty Then
Frame1.Caption = SomeOtherProperty
End If
End Sub
Module: Macros
Say your spreadsheet had a shape and you wanted to run that logic when it's clicked. You need to attach a macro to that shape - I like to regroup all macros in a standard module (.bas) called "Macros", that contains nothing but public procedures that all look like this:
Option Explicit
Public Sub DoSomething()
Dim presenter As MyPresenter
Set presenter = New MyPresenter
Dim theModel As MyModel
Set theModel = New MyModel
Dim theView As IView
Set theView = New MyUserForm
Set presenter.Model = theModel
Set presenter.View = theView
presenter.Show
End Sub
Now, if you want to test your presenter logic programmatically without showing a form, all you need to do is implement a "fake" view, and write a test method that will do what you need:
Class: MyFakeView
Option Explicit
Implements IView
Private Type TFakeView
IsCancelled As Boolean
End Type
Private this As TFakeView
Private Property Get IView_Model() As Object
Set IView_Model = Model
End Property
Private Property Set IView_Model(ByVal value As Object)
Set Model = value
End Property
Private Property Get IView_IsCancelled() As Boolean
IView_IsCancelled = IsCancelled
End Property
Private Sub IView_Show()
IsCancelled = False
End Sub
Public Property Get IsCancelled() As Boolean
IsCancelled = this.IsCancelled
End Property
Public Property Let IsCancelled(ByVal value As Boolean)
this.IsCancelled = value
End Property
Module: TestModule1
There are probably other tools out there, but since I actually wrote this one and I like how it works without a crap ton of boilerplate setup code or comments that contain executable instructions I'm going to warmly recommend using Rubberduck unit tests. Here's what a [very simple] test module might look like:
'#TestModule
Option Explicit
Option Private Module
Private Assert As New Rubberduck.AssertClass
'#TestMethod
Public Sub Model_SomePropertyInitializesEmpty()
On Error GoTo TestFail
'Arrange
Dim presenter As MyPresenter
Set presenter = New MyPresenter
Dim theModel As MyModel
Set theModel = New MyModel
Set presenter.Model = theModel
Set presenter.View = New MyFakeView
'Act
presenter.Show
'Assert
Assert.IsTrue theModel.SomeProperty = vbNullString
TestExit:
Exit Sub
TestFail:
Assert.Fail "Test raised an error: #" & Err.Number & " - " & Err.Description
End Sub
Rubberduck unit tests allow you to use this decoupled code to test everything you want to test about your application logic - as long as you keep that application logic decoupled and that you write testable code, you'll have unit tests that document how your VBA application is supposed to behave, tests that document what the specs are - just like you would have them in C# or Java, or any other OOP language one can write unit tests with.
Point is, VBA can do it, too.
Overkill? Depends. Specs changes all the time, code changes accordingly. Implementing all the application logic in spreadsheets' code-behind gets utterly annoying, because the Project Explorer doesn't drill down to module members, so finding what's implemented where can easily get annoying.
And it's even worse when the logic is implemented in the forms' code-behind and then you have Button_Click handlers making database calls or spreadsheet manipulations.
Code that's implemented in objects that have as few responsibilities as possible, makes code that's reusable, and that's easier to maintain.
Your question isn't exactly precise about exactly what you mean with "an Excel file with multiple userforms", but if you need to, you could have a "main" presenter class that receives 4-5 "child" presenters, each being responsible for the specific logic tied to each "child" form.
That said, if you have working code (that works exactly as intended) that you would like to refactor and make more efficient, or easier to read/maintain, you can post it on Code Review Stack Exchange, that's what that site is for.
Disclaimer: I maintain the Rubberduck project.
It depends on what launches these subs. If they are attached to a button or shape (which is what I tend to do for launching userforms) then it makes sense to put them in the module for the sheet that contains the shape. If buttons/shapes on several sheets refer to it -- put them in a general code module. I don't know if there really is a "best practice" here. The most important thing is to have consistency so that you don't have to go searching for things.

Identify form the method is being called from

I have a global method (in a module) that multiple forms are calling. I can't figure out how to pass/identify the calling form so that it's controls are recognised when referenced in the method:
Public Sub SomeFunction(callingForm As Form)
callingForm.ErrorProvider.SetError(TextBox1, "Faux pas!")
End Sub
Public Sub SomeOtherFunction(callingForm As Form)
SomeFunction(Me)
End Sub
I the above example, I've attempted passing the form as a parameter but I'm being told:
ErrorProvider is not a member of System.Windows.Forms.Form.
This is pretty common, to want to treat all your forms the same, yet different. You will want to create another class that each form can implement. This allows you to do something specific... generically.
Create a class similar to this, call it and the function whatever you want:
Public Interface IErrorForm
Sub MyValidate
End Interface
Implement it in your forms:
Public Class Form1
Implements IErrorForm
Public Sub MyValidate() Implements IErrorForm.MyValidate
'...Your code here
'TextBox1.Text = "Faux pas!"
End Sub
Now, wherever you want to call the function, you could do something like this:
Public Sub SomeFunction(callingForm As Form)
If GetType(IErrorForm).IsAssignableFrom(xFrm.GetType) Then
CType(xFrm, IErrorForm).MyValidate()
End If
End Sub
Another approach with returning value from Validate function
As you mentioned in the comments
...one of the key purposes of my method is to avoid having to set the
errors outside of the method, to reduce duplicitous code
As I understand you want Validate function check, given control as parameter, for errors and show error message through ErrorProvider.
My suggestion will be shared Validate function return string value, which contains error message generated after validating control
If no error then function return Nothing or String.Empty
Public Function Validate(ctrl As Object, formats As String) As String
Dim errorMessage As String = Nothing 'or String.Empty
' Your validating code here
' If no error errorMessage = Nothing
Return errorMessage
End Function
Then in the form (possible in the Validated event handler)
'....
Me.MyErrorprovider.SetError(Me.MyTextBox,
MyGlobalFunctions.Validate(Me.MyTextBox, "formats"))

.net dynamic loading

I've seen some other responses about this and they talk about interfaces but I'm pretty sure you can do this with classes and base classes but I can't this to work.
Public Class Behavior
Private _name As String
Public ReadOnly Property Name As String
Get
Return _name
End Get
End Property
Public Property EditorUpdate As Boolean
Public Sub New(ByVal name As String)
_name = name
EditorUpdate = False
End Sub
Public Overridable Sub Update()
End Sub
' runs right away in editor mode. also runs when in stand alone game mode right away
Public Overridable Sub Start()
End Sub
' runs after game mode is done and right before back in editor mode
Public Overridable Sub Finish()
End Sub
' runs right when put into game mode
Public Overridable Sub Initialize()
End Sub
' runs when the game is complete in stand alone mode to clean up
Public Overridable Sub Destroy()
End Sub
End Class
Public Class CharacterController
Inherits Behavior.Behavior
Public Sub New()
MyBase.New("Character Controller")
End Sub
Public Overrides Sub Update()
' TODO: call UpdateController()
' THINK: how can UpdateController() get the controller entity it's attached to?
' Behaviors need a way to get the entity they are attached to. Have that set when it's assigned in the ctor?
End Sub
End Class
Dim plugins() As String
Dim asm As Assembly
plugins = Directory.GetFileSystemEntries(Path.Combine(Application.StartupPath, "Plugins"), "*.dll")
For i As Integer = 0 To plugins.Length - 1
asm = Assembly.LoadFrom(plugins(i))
For Each t As Type In asm.GetTypes
If t.IsPublic Then
If t.BaseType.Name = "Behavior" Then
behaviorTypes.Add(t.Name, t)
Dim b As Behavior.Behavior
b = CType(Activator.CreateInstance(t), Behavior.Behavior)
'Dim o As Object = Activator.CreateInstance(t)
End If
End If
Next
Next
When it tries to convert whatever Activator.CreateInstance(t) returns to the base class of type Behavior I'm getting invalid cast exception. That type should be of CharacterController which is defined as a child of Behavior so why wouldn't it let me cast that? I've done something like this before but I can't find my code. What am I missing?
This may not be an answer to your question (it also might resolve your exception -- who knows), but it is something that needs to be pointed out. These lines:
If t.IsPublic Then
If t.BaseType.Name = "Behavior" Then
Should really be changed to one conditional like this one:
If t.IsPublic AndAlso (Not t.IsAbstract) AndAlso _
GetType(Behavior.Behavior).IsAssignableFrom(t) Then
Otherwise, if somebody defines a random type called "Behavior" in their own assembly and derives it from another type, your code will think it is a plugin. Additionally, if someone derives your Behavior type and then derives that type (two levels of inheritance) this code will incorrectly skip over that type. Using the IsAssignableFrom method is a quick and easy way to ensure that one type does actually derive from the specific type you want (instead of any type that shares the same name), even if there is another type in between your types in the inheritance tree. The additional check against t.IsAbstract will also ensure that you don't try to instantiate an abstract subtype of your base plugin type.
This works for me:
Dim ctor As Reflection.ConstructorInfo = _
t.GetConstructor(New System.Type() {})
Dim o As Object = ctor.Invoke(New Object() {})
Dim plugin As Plugin = TryCast(o, Plugin)
(If I find t, I invoke the parameterless constructor.)
[I just realized this is probably what Activator.CreateInstance does, so I replaced my code with yours and it worked your way -- so this probably won't help you]

Raising events in a class library exposed to COM

I'm trying to write a wrapper to a service, which will be used by an existing VB6 project. I've got most of the basic framework working, except for one important aspect: I can reference the wrapper in a VB6 project and subs/function calls etc. work as expected, but events do not. The events are visible in the VB6 app, but they never fire.
VB.NET Code:
Public Event Action_Response(ByVal Status as String)
Public Function TestEvent()
RaiseEvent Action_Response("Test Done")
Return "Done"
End Function
VB6 Code:
Dim WithEvents my_Wrapper as Wrapper_Class
Private Sub cmdTest_Click()
Set my_Wrapper = New Wrapper_Class
Debug.Print my_Wrapper.TestEvent()
End Sub
Private Sub my_Wrapper_Action_Response(ByVal Status As String)
Debug.Print Status
Set my_Wrapper = Nothing
End Sub
So, the cmdTest button code prints 'Done' as expected, but the Action_Response event doesn't fire. Is there something else do I need to do to get the event to fire?
Its too much to write in a comment, so I'll make it an answer....
First, identify the .net class you want to expose to COM. I'll pick a class called CORE.
Create an interface that describes the EVENTS that the CORE object will source (ie generate).
<ComVisible(True)> _
<Guid("some guid here...use guidgen, I'll call it GUID1")> _
<InterfaceType(ComInterfaceType.InterfaceIsIDispatch)> _
Public Interface ICoreEvents
<System.Runtime.InteropServices.DispId(1)> _
Sub FileLoaded(ByVal Message As String)
End Interface
Next, Create an interface for the COM exposed properties and methods of your class.
<ComVisible(True)> _
<Guid("another GUID, I'll call it guid2")> _
<InterfaceType(ComInterfaceType.InterfaceIsDual)> _
Public Interface ICore
ReadOnly Property Property1() As Boolean
ReadOnly Property AnotherProperty() As ISettings
ReadOnly Property Name() As String
ReadOnly Property Phone() As String
End Interface
Now, create your actual .net class
<ComVisible(True)> _
<ClassInterface(ClassInterfaceType.None)> _
<ComDefaultInterface(GetType(ICore))> _
<ComSourceInterfaces(GetType(ICoreEvents))> _
<Guid("a third GUID, I'll call it GUID3")> _
Public Class Core
Implements ICore
<System.Runtime.InteropServices.ComVisible(False)> _
Public Delegate Sub OnFileLoaded(ByVal Message As String)
Public Event FileLoaded As OnFileLoaded
End Class
Now, when you need to raise the FileLoaded event, just RAISEEVENT FILELOADED(Message) from within your class. .NET will forward the event out to COM because you've hooked up the COMSourceInterfaces attribute.
The attribute is shorthand for much of of this, but unfortunately doesn't give you quite the control that you need to do certain things (for instance retain version compatibility on your com interfaces).