Create gallery with images in Excel - vb.net

I am trying to make smth like this:
For now I use the imageMso attribute just for testing purposes. Even though, nothing really happens.
That's the XML for the gallery:
<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui" onLoad="Ribbon_Load">
<ribbon>
<tabs>
<tab idMso="TabAddIns" label="Gallery">
<group id="grpGallery" label="Example Gallery">
<gallery id="galleryID" label="My Gallery" columns="3" rows="2" size="large"
itemHeight="100" itemWidth="100"
getItemID="CallbackGetItemID"
getItemCount="CallbackGetItemsCount"
getItemImage="CallbackGetItemImage"
getItemScreentip="CallbackGetItemScreentip"
getItemSupertip="CallbackGetItemSupertip">
<item id="galImg1" imageMso="PictureBrightnessGallery"/>
<item id="galImg2" imageMso="ZoomPrintPreviewExcel"/>
</gallery>
....
And the VB code to it:
Public idCounter As Integer
Public Sub New()
idCounter = 0
End Sub
Public Function GetCustomUI(ByVal ribbonID As String) As String Implements Office.IRibbonExtensibility.GetCustomUI
Return GetResourceText("GalleryTest.Gallery.xml")
End Function
#Region "Ribbon Callbacks"
Public Sub Ribbon_Load(ByVal ribbonUI As Office.IRibbonUI)
Me.galleryRibbon = ribbonUI
End Sub
Public Sub CallbackGetItemID(control As Microsoft.Office.Core.IRibbonControl, _
index As Integer, ByRef itemID As Integer)
itemID = idCounter
idCounter += 1
End Sub
Public Sub CallbackGetItemsCount(control As Microsoft.Office.Core.IRibbonControl, _
ByRef count As Integer)
count = 6
End Sub
Public Sub CallbackGetItemScreentip(control As Microsoft.Office.Core.IRibbonControl, _
Index As Integer, ByRef screentip As String)
screentip = "Screentip"
End Sub
Public Sub CallbackGetItemSupertip(control As Microsoft.Office.Core.IRibbonControl, _
Index As Integer, ByRef supertip As String)
'TO DO'
End Sub
As you see, it's nothing fancy. I am just getting into the vb.net + excel world. What happens is that I get the "My Gallery" button for the dropdown, in the excel tab, but it is empty. No elements. Not even the dummy items.
Any suggestions?
P.S. I followed this documentation

Try to return actual values in the callbacks. For example, I see non-existing IDs in the callback.
There is no need to add the CallbackGetItemsCount callback for the gallery control if you specified items explicitly.
You can read more about the Ribbon UI in the following series of articles in MSDN:
Customizing the 2007 Office Fluent Ribbon for Developers (Part 1 of 3)
Customizing the 2007 Office Fluent Ribbon for Developers (Part 2 of 3)
Customizing the 2007 Office Fluent Ribbon for Developers (Part 3 of 3)

Related

update ribbon label and image based on values in a table

I have a custom ribbon, I'd like to make one of the buttons dynamic based on values in a table
so, when the form is closed, I'd like for the ribbon button and label to change based on changes made in the form (if there were any)
Here's my VBA code just for that button.
And I created 2 separate buttons with different images and labels in the USysRibbonImages table. I have mine setup a tad different, that table also stores button names, macro names and labels, besides the images. I did it that way since each image record can only be tied to one button anyway, so, figured I might as well make my images into buttons in the same table. And this process is automated somewhat. I'm explaining in case someone wonders why the code is a little different from what you usually see for ribbons.
But it works fine for static ribbons, it's once I want to make them a little dynamic is where I have issues
Public Sub fnGetRibbonImages(control As IRibbonControl, ByRef image)
Dim attach As Attachment
DoCmd.OpenForm "fZRibbonImages", acNormal, , , , acHidden
If control.ID = "btnServicesShippingWeightBucketsCollections" Or control.ID = "btnServicesShippingWeightBucketsCollectionsRed" Then
'regular
If dCount("MissingServicesShippingWeightBucketsID", "MissingServicesShippingWeightBuckets") > 0 Then
Forms("fZRibbonImages").Filter = "([USysRibbonImages].[ButtonName]='btnServicesShippingWeightBucketsCollections')"
Else
'red
Forms("fZRibbonImages").Filter = "([USysRibbonImages].[ButtonName]='btnServicesShippingWeightBucketsCollectionsRed')"
End If
Forms("fZRibbonImages").FilterOn = True
Set attach = Forms("fZRibbonImages").Controls.Item("Images")
Set image = attach.PictureDisp()
End If
DoCmd.Close acForm, "fZRibbonImages", acSaveYes
End Sub
Public Sub GetRibbonLabel(ByVal control As Office.IRibbonControl, ByRef returnedVal)
If control.ID = "btnServicesShippingWeightBucketsCollections" Or control.ID = "btnServicesShippingWeightBucketsCollectionsRed" Then
If dCount("MissingServicesShippingWeightBucketsID", "MissingServicesShippingWeightBuckets") > 0 Then
returnedVal = "FIX!!!!!"
Else
returnedVal = "Buckets"
End If
End If
End Sub
And here's my ribbon xml (I removed a bunch of buttons, the code is the same for all)
<?xml version="1.0" encoding="utf-8"?>
<customUI
xmlns="http://schemas.microsoft.com/office/2006/01/customui" onLoad="OnLoadRibbon" loadImage="OnLoadImage">
<ribbon startFromScratch="true">
<tabs>
<tab id="tabDefault" label="App Options">
<group id="grpMappings" label="Mappings">
<button id="btnZoneXWalk" label="Zone Xwalk" onAction="mZoneXWalk" getImage="fnGetRibbonImages" size="large"/>
<button id="btnServicesShippingWeightBucketsCollections" label="Shipping Weight Buckets" onAction="mServicesShippingWeightBucketsCollections" getImage="fnGetRibbonImages" size="large"/>
</group>
</tab>
</tabs>
</ribbon>
</customUI>
I tried putting this with the CLOSE button for the form
sbRefreshRibbon
MyRibbon.Invalidate
And here's the code for the sbRefreshRibbon sub
Public Sub sbRefreshRibbon()
On Error GoTo RestartApp
MyRibbon.Invalidate
On Error GoTo 0
Exit Sub
RestartApp:
MsgBox "Please restart Application for Ribbon changes to take effect", _
vbCritical, "Ribbon Refresh Failed"
End Sub
No luck, except after a few changes (don't remember exactly what I did, I've been at this for a while) I got an error that said to restart to reload the ribbon
Instead of the label attribute for the ribbon controls you need to use the getLabel one with a callback which should have the following signature:
C#: string GetLabel(IRibbonControl control)
VBA: Sub GetLabel(control As IRibbonControl, ByRef label)
C++: HRESULT GetLabel([in] IRibbonControl *pControl, [out, retval] BSTR *pbstrLabel)
Visual Basic: Function GetLabel(control As IRibbonControl) As String
So, in your ribbon XML file you need to replace the label attribute:
<group id="grpMappings" label="Mappings">
<button id="btnZoneXWalk" label="Zone Xwalk" onAction="mZoneXWalk" getImage="fnGetRibbonImages" size="large"/>
<button id="btnServicesShippingWeightBucketsCollections" getLabel="GetRibbonLabel" onAction="mServicesShippingWeightBucketsCollections" getImage="fnGetRibbonImages" size="large"/>
</group>
Read more about the Fluent UI (aka Ribbon UI) in the following articles:
Customizing the 2007 Office Fluent Ribbon for Developers (Part 1 of 3)
Customizing the 2007 Office Fluent Ribbon for Developers (Part 2 of 3)
Customizing the 2007 Office Fluent Ribbon for Developers (Part 3 of 3)

Can you put VBA code in a bare module, outside of Function or Sub?

I'm trying to keep a Collection Class of Classes persistent while a Userform is running so that the form objects they create can still have event handlers.
But if I create any classes for these in subs or functions, their respective classes and event handlers would be cleared at the end of whatever subroutine created it.
I should specify that user input determines how many classes there will be, so I can't just hard code the event handlers into the userform module.
You can use a publicly declared dictionary to hold instances of your class that will be available to your project. You declare variables outside of a function or sub and declare them as Public for other modules and their subs/functions to be able to use them. They stay resident in memory between calls while the application is open.
Consider a class called c_gumball:
Public color As String
Public diameterInches As Double
Public Function getSize(unit As String) As Double
Select Case unit
Case "mm"
getSize = diameterInches * 25.4
Case "cm"
getSize = diameterInches * 2.54
Case "yd"
getSize = diameterInches / 36
End Select
End Function
And then a new module called m_gbmachine:
Public gumballMachine As Dictionary
Public Sub createGumbalMachine()
gumballMachine = New Dictionary
End Sub
Public Sub addGumball(color As String, sizeInInches As Double, nameKey As String)
Dim gb As c_gumball
Set gb = New c_gumball
gb.color = "green"
gb.diameterInches = 1.2
gumballMachine.Add Key = nameKey, gb
End Sub
Public Sub removeGumball(nameKey As String)
gumballMachine.Remove (nameKey)
End Sub
Any module can now use m_gbmachine.gumballMachine dictionary and see what's in it. They can add gumballs using it's functions.
Perhaps in your userform you create a gumball called "gumball2" in your dictioanry and then want to get the color property of "gumball2" in the gumballMachine dictionary, you could do:
Public Sub button_Click()
'add gumball 2 to the machine
m_gbmachine.addGumball "green", 1.2, "gumball2"
End Sub
Public Sub someFormRoutine()
'msgbox the color of gumball 2
MsgBox m_gbmachine.gumballMachine("gumball2").color
End Sub
You can go deeper and change this module over to a class of it's own and have many gumball machine instances as well.

Get List of Functions and Subs in a class file

Is there a way to get a list of all of the Functions and Subs in Class file in Visual Studios? We're making extensive changes and I'd like to have a list in excel so I can use it to keep track of what I've already done.
I'd like to also get a list of every function/sub that references those subs/functions, but I can do that myself if necessary.
So, can this be done in Visual Studios?
Two options:
1. Programatically using Reflection and Type.GetMethods
See the MSDN page
Here is the example code on that page (I did not author this code, please see the link above)
Imports System
Imports System.Reflection
Imports System.Reflection.Emit
Imports Microsoft.VisualBasic
' Create a class having two public methods and one protected method.
Public Class MyTypeClass
Public Sub MyMethods()
End Sub 'MyMethods
Public Function MyMethods1() As Integer
Return 3
End Function 'MyMethods1
Protected Function MyMethods2() As [String]
Return "hello"
End Function 'MyMethods2
End Class 'MyTypeClass
Public Class TypeMain
Public Shared Sub Main()
Dim myType As Type = GetType(MyTypeClass)
' Get the public methods.
Dim myArrayMethodInfo As MethodInfo() = myType.GetMethods((BindingFlags.Public Or BindingFlags.Instance Or BindingFlags.DeclaredOnly))
Console.WriteLine((ControlChars.Cr + "The number of public methods is " & myArrayMethodInfo.Length.ToString() & "."))
' Display all the public methods.
DisplayMethodInfo(myArrayMethodInfo)
' Get the nonpublic methods.
Dim myArrayMethodInfo1 As MethodInfo() = myType.GetMethods((BindingFlags.NonPublic Or BindingFlags.Instance Or BindingFlags.DeclaredOnly))
Console.WriteLine((ControlChars.Cr + "The number of protected methods is " & myArrayMethodInfo1.Length.ToString() & "."))
' Display all the nonpublic methods.
DisplayMethodInfo(myArrayMethodInfo1)
End Sub 'Main
Public Shared Sub DisplayMethodInfo(ByVal myArrayMethodInfo() As MethodInfo)
' Display information for all methods.
Dim i As Integer
For i = 0 To myArrayMethodInfo.Length - 1
Dim myMethodInfo As MethodInfo = CType(myArrayMethodInfo(i), MethodInfo)
Console.WriteLine((ControlChars.Cr + "The name of the method is " & myMethodInfo.Name & "."))
Next i
End Sub 'DisplayMethodInfo
End Class 'TypeMain
2. With Visual Studio IDE and Code Metrics
Right click the Project
Calculate Code Metrics
In Code Metrics Results pane
Right click the Class
Open the Selection in Microsoft Excel
Might be an easier option.

vb.net - custom templates issue with databinding expressions in repeater control

I'm new here but I've been browsing stackoverflow for a while when looking for answers.
Here's the problem : I'm trying to implement a custom repeater with multiple conditional templates to avoid as much tests in the templates as possible
As for now my ascx code looks like that :
<custom:Repeater runat="server">
<headerTemplate>...</headerTemplate>
<templates>
<custom:template match="[filter1]"><contents>[filter1] is true for <%# Container.DataItem.ID%></contents></custom:template>
<custom:template match="[filter2]"><contents>[filter2] is true for <%# Container.DataItem.ID%></contents></custom:template>
</templates>
</custom:Repeater>
Besides that this syntax is too verbose, the following code works
<custom:template match="[filter1]"><contents><%# TypeOf Container is IDataItemContainer%></contents></custom:template>
But this code fails
<custom:template match="[filter1]"><contents>[filter1] is true for <%# Container.DataItem.ID%></contents></custom:template>
and I get the error message: : 'DataItem' is not a member of 'System.Web.UI.Control'.
It seems like vb tries to parse the template content at compile time instead of on databinding
Here are my vb classes
<ParseChildren(True, "contents")>
Public Class Template : Inherits WebControl : Implements ITemplate
Private _match As String
<PersistenceMode(PersistenceMode.Attribute)>
Public Property match() As String
Get
Return _match
End Get
Set(ByVal value As String)
'TODO compile filter as an expression
_match = value
End Set
End Property
Private _source As ITemplate
<PersistenceMode(PersistenceMode.Attribute)>
Public Property contents() As ITemplate
Get
Return Nothing
End Get
Set(ByVal value As ITemplate)
_source = value
End Set
End Property
Public Sub InstantiateIn(container As System.Web.UI.Control) Implements System.Web.UI.ITemplate.InstantiateIn
_source.InstantiateIn(container)
End Sub
End Class
<ParseChildren(True)>
Public Class ApplyTemplate : Inherits Repeater
_template as List(Of Template)
<PersistenceMode(PersistenceMode.InnerProperty), TemplateContainerAttribute(GetType(Template))>
Public Overloads Property templates() As List(Of Template)
Get
Return Nothing
End Get
Set(value As List(Of Template))
_templates = value
End Set
End Property
End Class
How can I add databinding expressions in my templates' content ?
Thanks in advance.
Max.
PS: Would it be possible (and how ;)) to compact the ascx code so it would look like this :
<custom:Repeater runat="server">
<headerTemplate>...</headerTemplate>
<custom:template match="[filter1]">[filter1] is true for <%# Container.DataItem.ID%></custom:template>
<custom:template match="[filter2]">[filter2] is true for <%# Container.DataItem.ID%></custom:template>
...
</custom:Repeater>
At last I had time to work on this again and thanks to this link (http://www.codeproject.com/Articles/21521/Creating-a-Templated-User-Control) I was able to implement my own custom repeater as I wanted to.
So now the aspx code looks like this
<custom:Repeater runat="server" >
<headerTemplate>...</headerTemplate>
<separatorTemplate on="1,9">some advertisement snippet</separatorTemplate>
<separatorTemplate every="2"><hr/></separatorTemplate>
<itemTemplate match="[filter1]"><source>[filter1] is true for <%# Container.DataItem.ID%></source></itemTemplate>
<itemTemplate match="[filter2]"><source>[filter2] is true for <%# Container.DataItem.ID%></source></itemTemplate>
...
</custom:Repeater>
The inner source tag is still necessary to allow code blocks in the template if needed.
If anybody knows how to remove it and still keep the feature with Metadata attributes, please comment.
So for the vb code here are the classes skeleton
Public Class Repeater
Inherits System.Web.UI.UserControl ' I use a UserControl so i can add support any html-bound attributes like class, style, data-*... without hardcoding them in the class
Private templates As New List(Of TemplateItem)
<PersistenceMode(PersistenceMode.InnerProperty)>
Public WriteOnly Property itemTemplate() As TemplateItem
Set(value As TemplateItem)
value.Container = Me 'to bind the container to the template instead of passing the reference on instanciation
templates.Add(value)
End Set
End Property
Public Overrides Sub DataBind()
If Not IsNothing(datasource) Then 'this to avoid nested controls Databind method to be called twice
[... iterate on dataitems]
[... template selection on best matching filters]
templates.instantiateFor(dataitem) ' to instanciate the template for the current item
[... iteration done]
MyBase.DataBind() ' to bind the newly created controls
End If
End Sub
...
End Class
'
<ParseChildren(True, "source")>
Public Class TemplateItem
Inherits Control
Friend Container As Repeater
'handle as many attributes as you want here
Private _matchExpression As String
<PersistenceMode(PersistenceMode.Attribute)>
Public Property match() As String
Get
Return _matchExpression
End Get
Set(value As String)
_matchExpression = value
End Set
End Property
'Now the simple part for parsing the inner code has a template
'I use the standard RepeaterItem class as the template container because i don't need more features for now
Private _source As ITemplate
<PersistenceMode(PersistenceMode.InnerDefaultProperty)>
<TemplateContainer(GetType(RepeaterItem))>
Public Property source() As ITemplate
Get
Return _source
End Get
Set(value As ITemplate)
_source = value
End Set
End Property
'now the part to instantiate as template for a given item
Public Sub instantiateFor(Item As Object, Optional itemIndex As Integer = -1)
Dim instantiator = New RepeaterItem(itemIndex, ListItemType.Item)
instantiator.DataItem = Item
_source.InstantiateIn(instantiator)
Container.Controls.Add(instantiator)
End Sub
End Class
Et voilĂ ... at last !!
Hope this will help some

How do I run a TFS Work Item Query with Visual Studio Macros

I'm trying to write a Vistual Studio 2008 macro to run a stored TFS query and display the results.
Previously I've created a query and named it 'Assigned to Me' to display all the work items currently assigned to me.
Instead of View->Team Explorer, click, click down the tree to My Queries then double click 'Assigned to me' I want to write a macro to automate these steps.
The best I've come up with is the rather messy:
Sub TemporaryMacro()
DTE.Windows.Item("{131369F2-062D-44A2-8671-91FF31EFB4F4}").Activate() 'Team Explorer
DTE.ActiveWindow.Object.GetItem("tfsserver\MyProject\Work Items\My Queries\Assigned to Me").Select(vsUISelectionType.vsUISelectionTypeSelect)
DTE.ActiveWindow.Object.DoDefaultAction()
DTE.Windows.Item("{131369F2-062D-44A2-8671-91FF31EFB4F4}").Close()
DTE.Windows.Item("Assigned to Me [Results]").Activate()
End Sub
Is there a better way?
I've written a custom windows form application to allow me to run my own dynamic queries, and create new or update existing work items.
Below is a simplified version of a section of code I use to connect to our TFS 2010 server, run a query and get the results back.
Imports Microsoft.TeamFoundation.Client
Imports Microsoft.TeamFoundation.WorkItemTracking.Client
Imports System.Net
Imports System.Text.RegularExpressions
Imports System.Data.SqlTypes
Public Class DNATFSProxy
Private _teamProjectCollection As TfsTeamProjectCollection
Private _workItemStore As WorkItemStore
Private _projectName As String
Private _project As Project
Public Sub Connect()
_teamProjectCollection = TfsTeamProjectCollectionFactory.GetTeamProjectCollection(New Uri(_uri))
_workItemStore = New WorkItemStore(_teamProjectCollection)
_project = _workItemStore.Projects(_projectName)
End Sub
Public Sub GetWorkItems(ByVal whereClause As String)
If _workItemStore IsNot Nothing Then
'Attempt to get the work items
Dim query As String = String.Format("SELECT * FROM WorkItems WHERE {0}", whereClause)
Dim workItemCollection As WorkItemCollection = _workItemStore.Query(query)
'Iterate through each work item
For Each workItem As WorkItem In workItemCollection
'Insert your custom code here
Dim title As String = workItem.Title.ToString()
'You can also update the work item in TFS
workItem.Title = "New title"
workItem.Save()
Next
End If
End Sub
Public Property URI() As String
Get
Return _uri
End Get
Set(ByVal value As String)
_uri = value
End Set
End Property
Public Property Project() As String
Get
Return _projectName
End Get
Set(ByVal value As String)
_projectName = value
End Set
End Property
End Class
You can then call this proxy as follows:
Dim proxy As New DNATFSProxy()
proxy.URI = "http://tfs:8080/tfs/DefaultCollection"
proxy.Project = "Your Project Name"
proxy.Connect()
proxy.GetWorkItems("Insert your query here")
I hope this helps!