From a macro I am accessing a command that is on the toolbar:
Dim name As String = "Macros.MyMacros.MyMacros.ToggleExceptions"
Dim cmd As EnvDTE.Command = DTE.Commands.Item(name)
How do I now change the caption of the command on the toolbar? It does not seem to have the necessary properties. Do I need to cast it to something else?
I've implemented it:
Private Sub Main()
Const BAR_NAME As String = "MenuBar"
Const CTL_NAME = "Foo"
ChangeCommandCaption(BAR_NAME, CTL_NAME, "Bar")
End Sub
Private Sub ChangeCommandCaption(ByVal cmdBarName As String, ByVal ctlName As String, ByVal caption As String)
Dim bars As Microsoft.VisualStudio.CommandBars.CommandBars
bars = DirectCast(DTE.CommandBars, Microsoft.VisualStudio.CommandBars.CommandBars)
If bars Is DBNull.Value Then Exit Sub
Dim menuBar As CommandBar = bars.Item(cmdBarName)
If menuBar Is DBNull.Value Then Exit Sub
Dim cmdBarCtl As CommandBarControl
Try
cmdBarCtl = menuBar.Controls.Item(ctlName)
If cmdBarCtl Is DBNull.Value Then Exit Sub
Catch ex As Exception
Exit Sub
End Try
cmdBarCtl.Caption = caption
End Sub
Related
I am new to .Net Visual Basic, I am currently self learning and trying to make some small application.
I need a help on Checking a sub menu item of ToolStripMenuItem
Complete concept is like:
I have a datagridview in which user will be able to rearrange the column or make a column visible or Hidded for this I have Sub / Function like below:
Public Sub Fun_Grid_Colomn_Visibility(ByVal GridName As DataGridView, ByRef ColName As String, ByVal MS_col As ToolStripMenuItem, ChkVal As Boolean)
If ChkVal = True Then
With GridName
.Columns("" & ColName & "").Visible = False
End With
MS_col.Checked = False
Exit Sub
End If
If ChkVal = False Then
GridName.Columns("" & ColName & "").Visible = True
MS_col.Checked = True
Exit Sub
End If
End Sub
On the form close I will be saving the user grid format as below (Got code from another Q/A Post) :
Public Sub WriteGrideViewSetting(ByVal dgv As DataGridView, ByVal FileName As String)
Dim settingwriter As XmlTextWriter = New XmlTextWriter("C:\Users\<username>\Desktop\temp\" & FileName & ".xml", Nothing)
settingwriter.WriteStartDocument()
settingwriter.WriteStartElement(dgv.Name)
Dim count As Integer = dgv.Columns.Count
For i As Integer = 0 To count - 1
settingwriter.WriteStartElement("column")
settingwriter.WriteStartElement("Name")
settingwriter.WriteString(dgv.Columns(i).Name)
settingwriter.WriteEndElement()
settingwriter.WriteStartElement("width")
settingwriter.WriteString(dgv.Columns(i).Width.ToString())
settingwriter.WriteEndElement()
settingwriter.WriteStartElement("headertext")
settingwriter.WriteString(dgv.Columns(i).HeaderText)
settingwriter.WriteEndElement()
settingwriter.WriteStartElement("displayindex")
settingwriter.WriteString(dgv.Columns(i).DisplayIndex.ToString())
settingwriter.WriteEndElement()
settingwriter.WriteStartElement("visible")
settingwriter.WriteString(dgv.Columns(i).Visible.ToString())
settingwriter.WriteEndElement()
settingwriter.WriteEndElement()
Next
settingwriter.WriteEndElement()
settingwriter.WriteEndDocument()
settingwriter.Close()
End Sub
End Module
If the user is reopening the form I used the below (Q/A code) to rearrange Datagridview column as pervious :
Public Sub ReadDataGridViewSetting(ByVal dgv As DataGridView, ByVal FileName As String, ByRef Frm_name As Form)
Dim xmldoc As XmlDocument = New XmlDocument()
Dim xmlnode As XmlNodeList
Dim CMSN_ToolName As String
Dim Var_file_Chk As String = "C:\Users\<user>\Desktop\temp\" & FileName & ".xml"
If System.IO.File.Exists(Var_file_Chk) = True Then
Dim fs As FileStream = New FileStream(Var_file_Chk, FileMode.Open, FileAccess.Read)
xmldoc.Load(fs)
xmlnode = xmldoc.GetElementsByTagName("column")
For i As Integer = 0 To xmlnode.Count - 1
Dim columnName As String = xmlnode(i).ChildNodes.Item(0).InnerText.Trim()
Dim width As Integer = Integer.Parse(xmlnode(i).ChildNodes.Item(1).InnerText.Trim())
Dim headertext As String = xmlnode(i).ChildNodes.Item(2).InnerText.Trim()
Dim displayindex As Integer = Integer.Parse(xmlnode(i).ChildNodes.Item(3).InnerText.Trim())
Dim visible As Boolean = Convert.ToBoolean(xmlnode(i).ChildNodes.Item(4).InnerText.Trim())
dgv.Columns(columnName).Width = width
dgv.Columns(columnName).HeaderText = headertext
dgv.Columns(columnName).DisplayIndex = displayindex
dgv.Columns(columnName).Visible = visible
Next
fs.Close()
End If
End Sub
Now what I need is that a Function or Sub for the Itemmenu. If a Particular column is Visible in the datagridview then the particular Itemmenu should be checked else it would be unchecked. I need this function when Itemmenu is being displayed / opened.
what I tried just (for sample) in Itemmenu opening is like
Private Sub ColumnsToolStripMenuItem_DropDownOpening(sender As Object, e As EventArgs) Handles ColumnsToolStripMenuItem.DropDownOpening
If DGV_CompList.Columns("DGC_Est").Visible = True Then
Dim CMSN_ToolName = MS_CV_Est.Name
Dim unused As ToolStripMenuItem = New ToolStripMenuItem(CMSN_ToolName) With {
.Checked = True
}
End If
End Sub
DGV_CompList -> DataGridView
DGC_Est -> Column Name of datagridview
MS_CV_Est -> - ToolStripMenuItem which need to checked
(Note: I will be changing the MenuItem Name to Match Datagrid Column name for Sync)
But the ToolStripMenuItem is not getting checked.
Actually I need function / Sub where I will be able to pass the grid name and the Menuname and loop through the grid columns and check if the column is visible or not if the particular column is visible then I need to check that item in the itemmenu.
I am requesting for the sub / function because it can be used for any toolstripmenuitem in any form.
Thanks and Regards.
As per #Jimi's hint, assigned each required Menuitem's Tag property with the datagridview column name and created the below sub / function :
Public Sub Fun_ToolStripMenuItem_Check(ByVal dgv As DataGridView, ByVal TS_Menu_Items As ToolStripItemCollection)
For Each item As ToolStripMenuItem In TS_Menu_Items.OfType(Of ToolStripMenuItem)
If Not item.Tag = "" Then
If dgv.Columns(item.Tag).Visible = True Then
item.Checked = True
Else
item.Checked = False
End If
End If
For Each submenu_item As ToolStripMenuItem In item.DropDownItems.OfType(Of ToolStripMenuItem)
If Not submenu_item.Tag = "" Then
If dgv.Columns(submenu_item.Tag).Visible = True Then
submenu_item.Checked = True
Else
submenu_item.Checked = False
End If
End If
Next
Next
End Sub
Note in the loop used - " OfType(Of ToolStripMenuItem) " because I have ToolStripSeparator between the Itemmenus.
On mouse over called the Sub by :
Private Sub MS_ColumnVisible_DropDownOpening(sender As Object, e As EventArgs) Handles MS_ColumnVisible.DropDownOpening
Fun_ToolStripMenuItem_Check(DGV_CompList, MS_CompDGV.Items)
End Sub
'DGV_CompList' - Datagridview Name and 'MS_CompDGV' - ContextMenuStrip Name
More important is that I did not assign any value to the Tag property to Menuitems which are not used show or hide the datagridview columns.
This question already has answers here:
How to create a popup menu in visual basic.net?
(2 answers)
Closed 5 years ago.
I have this code in VBA (shown in a simplified version) :
Sub TheMenu()
Dim Obj As CommandBar
Set Obj = Application.CommandBars.Add(Position:=msoBarPopup, MenuBar:=False, Temporary:=True)
Obj.Controls.Add(Type:=msoControlButton).Caption = "Button1"
Obj.Controls.Add(Type:=msoControlButton).Caption = "Button2"
Obj.ShowPopup
End Sub
I wish to make something equivalent (meaning "that looks similar and has similar uses", I don't need more) in VB.NET. Do you know any way of doing so?
I am using in VS2015, a "Windows Forms application" project using .NET framework 4.6.1 .
You can follow the example bellow here:
Public Class Connect
Implements Extensibility.IDTExtensibility2
Implements IDTCommandTarget
Private Const MY_COMMAND_NAME As String = "MyCommand"
Private applicationObject As EnvDTE.DTE
Private addInInstance As EnvDTE.AddIn
Private myStandardCommandBarControl As CommandBarControl
Private myToolsCommandBarControl As CommandBarControl
Private myCodeWindowCommandBarControl As CommandBarControl
Private myTemporaryToolbar As CommandBar
Private myTemporaryCommandBarPopup As CommandBarPopup
Public Sub OnConnection(ByVal application As Object, ByVal connectMode _
As Extensibility.ext_ConnectMode, ByVal addInInst As Object, _
ByRef custom As System.Array) Implements Extensibility.IDTExtensibility2.OnConnection
Dim myCommand As Command
Dim standardCommandBar As CommandBar
Dim menuCommandBar As CommandBar
Dim toolsCommandBar As CommandBar
Dim codeCommandBar As CommandBar
Dim toolsCommandBarControl As CommandBarControl
Dim myCommandBarButton As CommandBarButton
Dim position As Integer
Try
applicationObject = CType(application, EnvDTE.DTE)
addInInstance = CType(addInInst, EnvDTE.AddIn)
Select Case connectMode
Case ext_ConnectMode.ext_cm_AfterStartup, ext_ConnectMode.ext_cm_Startup
' Try to retrieve the command, just in case it was already created
Try
myCommand = applicationObject.Commands.Item(addInInstance.ProgID & "." & "MyCommand")
Catch
End Try
' Add the command if it does not exists
If myCommand Is Nothing Then
myCommand = applicationObject.Commands.AddNamedCommand(addInInstance, _
"MyCommand", "MyCommand", "Executes the command for MyAddin", True, 59, Nothing, _
vsCommandStatus.vsCommandStatusSupported Or vsCommandStatus.vsCommandStatusEnabled)
End If
' Retrieve some built-in command bars
standardCommandBar = applicationObject.CommandBars.Item("Standard")
menuCommandBar = applicationObject.CommandBars.Item("MenuBar")
toolsCommandBar = applicationObject.CommandBars.Item("Tools")
codeCommandBar = applicationObject.CommandBars.Item("Code Window")
' Add a button to the built-in "Standard" toolbar
myStandardCommandBarControl = myCommand.AddControl(standardCommandBar, _
standardCommandBar.Controls.Count + 1)
myStandardCommandBarControl.Caption = MY_COMMAND_NAME
' Change the button style, which must be done casting the control to a button
myCommandBarButton = DirectCast(myStandardCommandBarControl, CommandBarButton)
myCommandBarButton.Style = MsoButtonStyle.msoButtonIcon
' Add a button to the built-in "Tools" menu
myToolsCommandBarControl = myCommand.AddControl(toolsCommandBar, toolsCommandBar.Controls.Count + 1)
myToolsCommandBarControl.Caption = MY_COMMAND_NAME
' Add a button to the built-in "Code Window" context menu
myCodeWindowCommandBarControl = myCommand.AddControl(codeCommandBar, codeCommandBar.Controls.Count + 1)
myCodeWindowCommandBarControl.Caption = MY_COMMAND_NAME
' Add a new toolbar with a button on it
myTemporaryToolbar = applicationObject.CommandBars.Add("MyTemporaryToolbar", _
MsoBarPosition.msoBarTop, System.Type.Missing, True)
' Change the button style, which must be done casting the control to a button
myCommandBarButton = DirectCast(myCommand.AddControl(myTemporaryToolbar), CommandBarButton)
myCommandBarButton.Style = MsoButtonStyle.msoButtonIcon
' Make visible the toolbar
myTemporaryToolbar.Visible = True
' Calculate the position of a new command bar popup by the "Tools" menu
toolsCommandBarControl = DirectCast(toolsCommandBar.Parent, CommandBarControl)
position = toolsCommandBarControl.Index + 1
' Add a new command bar popup with a button on it
myTemporaryCommandBarPopup = DirectCast(menuCommandBar.Controls.Add( _
MsoControlType.msoControlPopup, System.Type.Missing, System.Type.Missing, _
position, True), CommandBarPopup)
myTemporaryCommandBarPopup.CommandBar.Name = "MyTemporaryCommandBarPopup"
myTemporaryCommandBarPopup.Caption = "My menu"
myCommand.AddControl(myTemporaryCommandBarPopup.CommandBar)
myTemporaryCommandBarPopup.Visible = True
End Select
Catch e As System.Exception
System.Windows.Forms.MessageBox.Show(e.ToString)
End Try
End Sub
Public Sub OnDisconnection(ByVal RemoveMode As Extensibility.ext_DisconnectMode, _
ByRef custom As System.Array) Implements Extensibility.IDTExtensibility2.OnDisconnection
Try
If Not (myStandardCommandBarControl Is Nothing) Then
myStandardCommandBarControl.Delete()
End If
If Not (myCodeWindowCommandBarControl Is Nothing) Then
myCodeWindowCommandBarControl.Delete()
End If
If Not (myToolsCommandBarControl Is Nothing) Then
myToolsCommandBarControl.Delete()
End If
If Not (myTemporaryToolbar Is Nothing) Then
myTemporaryToolbar.Delete()
End If
If Not (myTemporaryCommandBarPopup Is Nothing) Then
myTemporaryCommandBarPopup.Delete()
End If
Catch e As System.Exception
System.Windows.Forms.MessageBox.Show(e.ToString)
End Try
End Sub
Public Sub OnBeginShutdown(ByRef custom As System.Array) Implements Extensibility.IDTExtensibility2.OnBeginShutdown
End Sub
Public Sub OnAddInsUpdate(ByRef custom As System.Array) Implements Extensibility.IDTExtensibility2.OnAddInsUpdate
End Sub
Public Sub OnStartupComplete(ByRef custom As System.Array) Implements _
Extensibility.IDTExtensibility2.OnStartupComplete
End Sub
Public Sub Exec(ByVal cmdName As String, ByVal executeOption As vsCommandExecOption, _
ByRef varIn As Object, ByRef varOut As Object, ByRef handled As Boolean) Implements IDTCommandTarget.Exec
handled = False
If (executeOption = vsCommandExecOption.vsCommandExecOptionDoDefault) Then
If cmdName = addInInstance.ProgID & "." & MY_COMMAND_NAME Then
handled = True
System.Windows.Forms.MessageBox.Show("Command executed.")
End If
End If
End Sub
Public Sub QueryStatus(ByVal cmdName As String, ByVal neededText As vsCommandStatusTextWanted, _
ByRef statusOption As vsCommandStatus, ByRef commandText As Object) Implements IDTCommandTarget.QueryStatus
If neededText = EnvDTE.vsCommandStatusTextWanted.vsCommandStatusTextWantedNone Then
If cmdName = addInInstance.ProgID & "." & MY_COMMAND_NAME Then
statusOption = CType(vsCommandStatus.vsCommandStatusEnabled + _
vsCommandStatus.vsCommandStatusSupported, vsCommandStatus)
Else
statusOption = vsCommandStatus.vsCommandStatusUnsupported
End If
End If
End Sub
End Class
In OS WIn 7 using Autocad 2007 I try to select items then do stuff
Problem is that there are no ITEMS in the selection set ssetObj - not sure why!
Code: works in vba but not standalone vb.net
Private Sub CommandButton1_Click()
Dim myapp As AcadApplication
Dim mydoc As AcadDocument
Dim ssetObj As AcadSelectionSet
Dim ent As AcadObject
Dim numVertices As Long
On Error GoTo err:
Set myapp = GetObject(, "AutoCAD.Application.17")
Set mydoc = myapp.ActiveDocument
If mydoc.SelectionSets.Count > 0 Then
mydoc.SelectionSets(0).Delete
End If
Set ssetObj = mydoc.SelectionSets.Add("ss")
list1.Clear
Me.Hide
AppActivate ("Autocad")
ssetObj.SelectOnScreen:'WORKS TO SELECT
Dim numpls As Integer
numpls = ssetObj.Count:'WORKS TO GET COUNT
Dim i As Integer
For i = 0 To numpls - 1
Set ent = ssetObj.Item(i)':PROBLEM HERE**THERE ARE NO ITEMS THOUGH COUNT IS CORRECT
If ent.ObjectName = "AcDbLWPolyline" Or ent.ObjectName = "AcDbPolyline" Then
numVertices = (UBound(ent.Coordinates) + 1) / 2
list1.AddItem Str(ent.ObjectID) + "\" + Str(numVertices) + " Vertices"
End If
Next i
Me.Show
Exit Sub
err:
MsgBox err.Description
End Sub
Edit: Further investigation shows that you should be calling ssetObj(i) if you want to get indexed items of your selection set.
I'd not worry about trying to get the count of the selection set anyway if you plan on iterating through it. A For Each should suffice to walk though it. One of the problems with going from VBA/VB6 to VB.NET is the temptation to use the same methodology, when it can sometimes be invalid (at times it can be excellent, but .NET is very capable). Here's my entire class that I tested your problem with, just to show how I'm connecting to AutoCAD and interfacing with it.
Public Class frmMain
Private acApp As AcadApplication
Private polyList As List(Of String)
Const acProgId As String = "AutoCAD.Application.17"
<DllImport("User32.dll")> _
Private Shared Function SetForegroundWindow(ByVal hWnd As IntPtr) As Boolean
End Function
Private Sub btnStart_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnStart.Click
Try
acApp = DirectCast(Marshal.GetActiveObject(acProgId), AcadApplication)
Catch
Try
Dim acType = Type.GetTypeFromProgID(acProgId)
acApp = DirectCast(Activator.CreateInstance(acType), AcadApplication)
Catch ex As Exception
MsgBox("Unable to create AutoCAD application of type: " & acProgId)
End Try
End Try
End Sub
Private Sub btnSelect_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnSelect.Click
If acApp Is Nothing Then Return
acApp.Visible = True
Dim acDoc As AcadDocument = acApp.ActiveDocument
' Kill all existing selection sets
While (acDoc.SelectionSets.Count > 0)
acDoc.SelectionSets(0).Delete()
End While
Dim mySS As AcadSelectionSet = acDoc.SelectionSets.Add("ss")
SetForegroundWindow(acApp.HWND)
mySS.SelectOnScreen()
polyList = New List(Of String)
Dim numVertices As Integer
For Each ent As AcadEntity In mySS
If ent.ObjectName = "AcDbLWPolyline" Or
ent.ObjectName = "AcDbPolyline" Then
numVertices = (ent.Coordinates.Length) / 2
polyList.Add(String.Format("{0} \ {1} Vertices", ent.ObjectID, numVertices))
End If
Next
End Sub
End Class
External COM methods like this are going to be slower than you're used to seeing via VBA. Therefore it's definitely worth diving into the in-process AutoCAD .NET stuff to see great performance.
Hey all i have this being called:
Public Sub doStuff(ByVal what2Do As String)
Dim command As String = ""
If Trim(lanSent(1)) = "turnOffPC" Then
command = "r5"
ElseIf Trim(lanSent(1)) = "TurnOnPC" Then
command = "r3"
End If
Dim t As New Threading.Thread(AddressOf androidWS)
t.SetApartmentState(Threading.ApartmentState.STA)
t.Start()
End Sub
Private Shared Sub androidWS(ByVal command As String)
Dim arduinoWebSite As New WebBrowser
arduinoWebSite.Navigate("http://192.168.9.39:19/?r=" & command)
End Sub
And i am wondering how i can send a value to androidWS?
updated code that works
Public Sub doStuff(ByVal what2Do As String)
Dim command As String = ""
If Trim(lanSent(1)) = "turnOffPC" Then
command = "r5"
ElseIf Trim(lanSent(1)) = "TurnOnPC" Then
command = "r3"
End If
Dim t As New Threading.Thread(AddressOf androidWS)
t.SetApartmentState(Threading.ApartmentState.STA)
t.Start(command)
End Sub
Private Shared Sub androidWS(ByVal command As Object)
Dim arduinoWebSite As New WebBrowser
arduinoWebSite.Navigate("http://192.168.9.39:19/?r=" & command)
End Sub
You use the Thread.Start(Object) overload to pass data to your handler sub.
http://msdn.microsoft.com/en-us/library/6x4c42hc.aspx
In excel vba I have added a commandbutton to userform... like below
Set ctrl = Me.Controls.Add( _
bstrProgID:="Forms.CommandButton.1", _
Name:="CommandButton1", Visible:=True)
Now I wanted to know how would I tell it what to do when it is clicked?
This is one of those techniques that vba will let you do, but you probably shouldn't. For all the same reasons you shouldn't use code that alters your code.
That said, here is how to do what you want. First insert a class module and name it DynBtn, then paste this code into it:
Private WithEvents mobjBtn As MSForms.CommandButton
Private msOnAction As String
''// This has to be generic or call by name won't be able to find the methods
''// in your form.
Private mobjParent As Object
Public Property Get Object() As MSForms.CommandButton
Set Object = mobjBtn
End Property
Public Function Load(ByVal parentFormName As Object, ByVal btn As MSForms.CommandButton, ByVal procedure As String) As DynBtn
Set mobjParent = parentFormName
Set mobjBtn = btn
msOnAction = procedure
Set Load = Me
End Function
Private Sub Class_Terminate()
Set mobjParent = Nothing
Set mobjBtn = Nothing
End Sub
Private Sub mobjBtn_Click()
CallByName mobjParent, msOnAction, VbMethod
End Sub
Now to use this in your form, create a blank user form and paste this code into it:
Private Const mcsCmdBtn As String = "Forms.CommandButton.1"
Private mBtn() As DynBtn
Private Sub UserForm_Initialize()
Dim i As Long
ReDim mBtn(1) As DynBtn
For i = 0 To UBound(mBtn)
Set mBtn(i) = New DynBtn
Next
''// One Liner
mBtn(0).Load(Me, Me.Controls.Add(mcsCmdBtn, "Btn1", True), "DoSomething").Object.Caption = "Test 1"
''// Or using with block.
With mBtn(1).Load(Me, Me.Controls.Add(mcsCmdBtn, "Btn2", True), "DoSomethingElse").Object
.Caption = "Test 2"
.Top = .Height + 10
End With
End Sub
Public Sub DoSomething()
MsgBox "It Worked!"
End Sub
Public Sub DoSomethingElse()
MsgBox "Yay!"
End Sub
Private Sub UserForm_Terminate()
Erase mBtn
End Sub