Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
896to900
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
896to900
896to900
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Add In

Add In
20.08.2007 20:44:00
Type
Ich möchte mit einem Add-In ein Menue und eine Commandbar mit eigenen Icon's zur verfügung stellen.
Kein Problem - Nur die Icon's lassen sich nicht aus dem Add-In heraus laden. Die Icon's liegen als
Bilder in der Tabelle vor und alles Funktioniert, nur wenn das Add-In als solches deklariert ist und die Tabelle
dann unsichtbar wird, arbeitet das Makro nicht mehr einwandfrei. Wer kann helfen?

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Add In
20.08.2007 20:59:09
mumpel
Hallo!
Versuch's mal so.
Am Anfang des Makros diese Zeile: ThisWorkbook.IsAddin = False
Am Ende des Makros diese Zeile: ThisWorkbook.IsAddin = True
Gruß, Rene

AW: Add In
20.08.2007 21:13:48
Type
Danke Rene,
aber jetzt ist der Nebeneffekt, daß jedesmal eine Speicherabfrage kommt

AW: Add In
20.08.2007 21:23:55
Herbert
Hi,
dein Code deines Versuchs wäre hilfreich.
mfg Herbert

AW: Add In
20.08.2007 21:57:00
Type
Sub Auto_Open()
Dim BefehlsLeiste As CommandBar
Dim NeuesElement As CommandBarButton
On Error GoTo Fehler
ThisWorkbook.IsAddin = False
If CBDoesCBExist(strCBarName) = True Then
Exit Sub
Else
If Not SearchMenu("Meine") Then Call Menü_Hinzu
Set BefehlsLeiste = CommandBars.Add(Name:=strCBarName, Position:=msoBarLeft, temporary:=True)
BefehlsLeiste.Visible = True
Call AddCommandBarControlButton(strCBarName, "Optionen An Aus", "Optionen", 229)
Call AddCommandBarControlButton(strCBarName, "Kilometer", "KMFormat", 330)
Call AddCommandBarControlButton(strCBarName, "Meter", "mFormat", 25)
Call AddCommandBarControlButton(strCBarName, "Quadratmeter", "qmFormat", 26)
Call AddCommandBarControlButton(strCBarName, "Kubikmeter", "KubikmFormat", 27)
Call AddCommandBarControlButton(strCBarName, "Stunden", "StdFormat", 33)
Call AddCommandBarControlButton(strCBarName, "Liter", "LtFormat", 480)
Call AddCommandBarControlButton(strCBarName, "Uhr", "UhrFormat", 126)
Call AddCommandBarControlButton(strCBarName, "Secunden", "SecFormat", 734)
Call AddCommandBarControlButton(strCBarName, "Format", "SonntagZellen", 2170)
Call AddCommandBarControlButton(strCBarName, " € ", "EuFormat", 8)
Call AddCommandBarControlButton(strCBarName, "Spalten einblenden", "SpaltenEinblenden", 1650)
Call AddCommandBarControlButton(strCBarName, "Spalten ausblenden", "SpaltenAusblenden", 1649)
Call AddCommandBarControlButton(strCBarName, "Zeilen einblenden", "ZeilenEinblenden", 1653)
Call AddCommandBarControlButton(strCBarName, "Zeilen ausblenden", "ZeilenAusblenden", 1652)
Call AddCommandBarControlButton(strCBarName, "Tage ermitteln", "Tage", 744)
Set NeuesElement = CommandBars(strCBarName).Controls.Add(Type:=msoControlButton, Id:=1695)
Set NeuesElement = CommandBars(strCBarName).Controls.Add(Type:=msoControlButton, Id:=458)
Set NeuesElement = CommandBars(strCBarName).Controls.Add(Type:=msoControlButton, Id:=485)
End If
ThisWorkbook.IsAddin = True
Exit Sub
Fehler:
MsgBox Err.Number & " " & Err.Description
End Sub


Sub Auto_close()
If CBDoesCBExist(strCBarName) = True Then
CBDeleteCommandBar strCBarName
End If
Sub MenüWeg()
MenuBars(xlWorksheet).Menus(strMenuName).Delete
'Application.CommandBars("MeinM").Delete
End Sub


Function HoleBild(Nr As Long)
Dim Pic As String
Pic = "Bild" & Nr
Sheets("TB").Shapes(Pic).Select
Selection.Copy
End Function


Sub Menü_Hinzu()
On Error GoTo Fehler
Dim neuesMenü As Object
Dim ML As CommandBar
Set ML = CommandBars("Worksheet Menu Bar") '(MenuBar)
Set neuesMenü = ML.Controls.Add(Type:=msoControlPopup, temporary:=True)
neuesMenü.Caption = strMenuName
neuesMenü.Tag = "Meine"
Set neuerEintrag = neuesMenü.Controls.Add(Type:=msoControlButton)
' HoleBild 1
With neuerEintrag
' .PasteFace
.FaceID = 229
.OnAction = "Optionen" '1
.Caption = "Optionen An Aus"
End With
Set neuerEintrag = neuesMenü.Controls.Add(Type:=msoControlButton)
HoleBild 25
With neuerEintrag
.PasteFace
' .FaceID = 673
.OnAction = "mFormat" '25
.Caption = "Meter"
End With
Set neuerEintrag = neuesMenü.Controls.Add(Type:=msoControlButton)
HoleBild 26
With neuerEintrag
.PasteFace
' .FaceID = 673
.OnAction = "qmFormat" '26
.Caption = "Quadratmeter"
End With
Set neuerEintrag = neuesMenü.Controls.Add(Type:=msoControlButton)
HoleBild 27
With neuerEintrag
.PasteFace
' .FaceID = 673
.OnAction = "KubikmFormat" '27
.Caption = "Kubikmeter"
End With
Set neuerEintrag = neuesMenü.Controls.Add(Type:=msoControlButton)
' HoleBild 2
With neuerEintrag
' .PasteFace
.FaceID = 330
.OnAction = "KMFormat" '2
.Caption = "Kilometer"
End With
Set neuerEintrag = neuesMenü.Controls.Add(Type:=msoControlButton)
' HoleBild 3
With neuerEintrag
' .PasteFace
.FaceID = 33
.OnAction = "StdFormat" '3
.Caption = "Stunden"
End With
Set neuerEintrag = neuesMenü.Controls.Add(Type:=msoControlButton)
' HoleBild 4
With neuerEintrag
' .PasteFace
.FaceID = 480
.OnAction = "LtFormat" '4
.Caption = "Liter"
End With
Set neuerEintrag = neuesMenü.Controls.Add(Type:=msoControlButton)
' HoleBild 5
With neuerEintrag
' .PasteFace
.FaceID = 126
.OnAction = "UhrFormat" '5
.Caption = "Uhr"
End With
Set neuerEintrag = neuesMenü.Controls.Add(Type:=msoControlButton)
' HoleBild 6
With neuerEintrag
' .PasteFace
.FaceID = 734
.OnAction = "SecFormat" '6
.Caption = "Secunden"
End With
Set neuerEintrag = neuesMenü.Controls.Add(Type:=msoControlButton)
' HoleBild 7
With neuerEintrag
' .PasteFace
.FaceID = 2170
.OnAction = "SonntagZellen" '7
.Caption = "Format"
.Tag = "Sonntag"
End With
Set neuerEintrag = neuesMenü.Controls.Add(Type:=msoControlButton)
HoleBild 8
With neuerEintrag
.PasteFace
' .FaceID = 395
.TooltipText = "€ Euroformat"
.OnAction = "EuFormat" '8
.Caption = "€ Euro"
.Tag = "Euro"
End With
' With NeuesElement
'' .PasteFace
' .Style = msoButtonCaption
' .BuiltInFace = True
' .FaceId = 588
' .TooltipText = "€ Euroformat"
' .Caption = "€"
' .Tag = "Euro"
' .OnAction = "EuFormat" '8
' End With
Set neuerEintrag = neuesMenü.Controls.Add(Type:=msoControlButton, Id:=1695)
Set neuerEintrag = neuesMenü.Controls.Add(Type:=msoControlButton, Id:=458)
Set neuerEintrag = neuesMenü.Controls.Add(Type:=msoControlButton, Id:=485)
Exit Sub
Fehler:
MsgBox Err.Number & " " & Err.Description
End Sub



Private Function SearchMenu(srchTag As String) As Boolean
SearchMenu = True
'Set cbr = CommandBars("Menu Bar")
Dim myMenu
Set myMenu = CommandBars.FindControl(Type:=msoControlPopup, Tag:=srchTag)
If myMenu Is Nothing Then SearchMenu = False
End Function


Function AddCommandBarControlButton(strCommandBarName As String, strButtonCaption As String, strFunction As String, Optional FaceID As Long) ', Optional lngID As Long
' Diese Prozedur fügt eine neue Steuerelement-Schaltfläche zur Befehlsleiste
' hinzu, die in der strCommandBarName-Variablen angegeben ist, und
' legt ihre Eigenschaften "Caption", "Style","FaceID" und "OnAction" fest.
Dim cmdBar As CommandBar
Dim ctlNew As CommandBarButton
On Error Resume Next
Set cmdBar = CommandBars(strCommandBarName)
Set ctlNew = cmdBar.Controls.Add(msoControlButton)
Select Case FaceID
Case Is = 8, 25, 26, 27
HoleBild FaceID
ctlNew.PasteFace
ctlNew.Caption = strButtonCaption
ctlNew.OnAction = strFunction
Exit Function
End Select
ctlNew.FaceID = FaceID
ctlNew.Caption = strButtonCaption
' ctlNew.Style = msoButtonIconAndCaption
ctlNew.OnAction = strFunction
End Function


Anzeige
AW: Add In
20.08.2007 22:59:49
Herbert
Hi,
was für ein Chaos.
Alles, was das Addin betrifft mit Thisworkbook referenzieren.
Select und activate hat da nichts zu suchen.
mfg Herbert

AW: Add In
21.08.2007 08:47:00
Renee
Hi,
Grundsätzlich kannst Du ein Bild von dem Tabellenblatt des Add-Ins (auch vom versteckten), so auf einen Button kopieren:

ThisWorkbook.Sheets("BlattName").Shapes("BildName").Copy
CommandBars("SymbolLeisteName").Controls(IndexButton).PasteFace


Greetz Renee
P.S. Den Code würde ich dringenst überarbeiten. Der ist nicht nur unübersichtlich sondern in vielen Belangen überflüssig, bzw. lässt sich generalisieren.

Anzeige
AW: Add In
21.08.2007 20:41:00
Type
Danke Renee,
alles wenn mal Zeit ist
bis dann

AW: Add In
20.08.2007 21:53:20
Renee
Hi von im der Typin im Rechner!
...dann unsichtbar wird, arbeitet das Makro nicht mehr einwandfrei.
Dann ist das Makro falsch geschrieben, aber raten liegt mir nicht, also zeig Her Euren Code Hochwürgen.
Greetz Renee

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige