Új hozzászólás Aktív témák

• #39271 Mutt senior tag Kobe #39270

  Új Válasz 2018-10-05 13:36:42 #39271

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Mutt

  senior tag

  válasz Kobe #39270 üzenetére

  Szia,

  A ribbon módosítást nem vágom, de nekem az alábbi kód Excel 2010 óta jól megy saját készítésű addin-ban:

  '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' START ThisWorkbook Code Module
' Created By Chip Pearson, chip@cpearson.com
' Sample code for Creating An Add-In at http://www.cpearson.com/Excel/CreateAddIn.aspx
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit

Private Const C_TAG = "Makro" ' C_TAG should be a string unique to this add-in.
Private Const C_TOOLS_MENU_ID As Long = 30007&


Private Sub Workbook_Open()
'''''''''''''''''''''''''''''''''''''''''''''''
' Workbook_Open
' Create a submenu on the Tools menu. The
' submenu has two controls on it.
'''''''''''''''''''''''''''''''''''''''''''''''
Dim ToolsMenu As Office.CommandBarControl
Dim ToolsMenuItem As Office.CommandBarControl
Dim ToolsMenuControl As Office.CommandBarControl

'''''''''''''''''''''''''''''''''''''''''''''''
' First delete any of our controls that
' may not have been properly deleted previously.
'''''''''''''''''''''''''''''''''''''''''''''''
DeleteControls

''''''''''''''''''''''''''''''''''''''''''''''
' Get a reference to the Tools menu.
''''''''''''''''''''''''''''''''''''''''''''''
Set ToolsMenu = Application.CommandBars.FindControl(ID:=C_TOOLS_MENU_ID)
If ToolsMenu Is Nothing Then
MsgBox "Unable to access Tools menu.", vbOKOnly
Exit Sub
End If

''''''''''''''''''''''''''''''''''''''''''''''
' Create a item on the Tools menu.
''''''''''''''''''''''''''''''''''''''''''''''
' Set ToolsMenuItem = ToolsMenu.Controls.Add(Type:=msoControlPopup, temporary:=True)
' If ToolsMenuItem Is Nothing Then
' MsgBox "Unable to add item to the Tools menu.", vbOKOnly
' Exit Sub
' End If
'
' With ToolsMenuItem
' .Caption = "&Menu Item"
' .BeginGroup = True
' .Tag = C_TAG
' End With

''''''''''''''''''''''''''''''''''''''''''''''
' Create the first control on the new item
' in the Tools menu.
''''''''''''''''''''''''''''''''''''''''''''''
' Set ToolsMenuControl = ToolsMenuItem.Controls.Add(Type:=msoControlButton, temporary:=True)
Set ToolsMenuControl = ToolsMenu.Controls.Add(Type:=msoControlButton, temporary:=True)

If ToolsMenuControl Is Nothing Then
MsgBox "Unable to add item to Tools menu item.", vbOKOnly
Exit Sub
End If

With ToolsMenuControl
''''''''''''''''''''''''''''''''''''
' Set the display caption and the
' procedure to run when clicked.
''''''''''''''''''''''''''''''''''''
.Caption = "Ékezetek" 'idejön a saját elnevezésed
.OnAction = "'" & ThisWorkbook.Name & "'!Ekezetek" 'ez pedig a saját kódod
.Tag = C_TAG
End With

''''''''''''''''''''''''''''''''''''''''''''''
' Create another control on the new item
' in the Tools menu.
''''''''''''''''''''''''''''''''''''''''''''''
Set ToolsMenuControl = ToolsMenu.Controls.Add(Type:=msoControlButton, temporary:=True)
If ToolsMenuControl Is Nothing Then
MsgBox "Unable to add item to Tools menu item.", vbOKOnly
Exit Sub
End If

With ToolsMenuControl
''''''''''''''''''''''''''''''''''''
' Set the display caption and the
' procedure to run when clicked.
''''''''''''''''''''''''''''''''''''
.Caption = "SQL/BO Converter"
.OnAction = "'" & ThisWorkbook.Name & "'!Converter"
.Tag = C_TAG
End With

End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
''''''''''''''''''''''''''''''''''''''''''''''''''''
' Workbook_BeforeClose
' Before closing the add-in, clean up our controls.
''''''''''''''''''''''''''''''''''''''''''''''''''''
DeleteControls
End Sub


Private Sub DeleteControls()
''''''''''''''''''''''''''''''''''''
' Delete controls whose Tag is
' equal to C_TAG.
''''''''''''''''''''''''''''''''''''
Dim Ctrl As Office.CommandBarControl

On Error Resume Next
Set Ctrl = Application.CommandBars.FindControl(Tag:=C_TAG)

Do Until Ctrl Is Nothing
Ctrl.Delete
Set Ctrl = Application.CommandBars.FindControl(Tag:=C_TAG)
Loop

End Sub

  üdv

Új hozzászólás Aktív témák