Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Probleme mit einem ADD-IN

Forumthread: Probleme mit einem ADD-IN

Probleme mit einem ADD-IN
10.02.2004 17:37:21
Juerg
Ich habe hier eine Antwort auf den Thread zwischen Til_Eulenspiegel603 und Nepumuk vom 04.06.2003
es ist möglich eine Taskliste vollstänig über vba zu erstellen und sie wieder zu löschen.. nachfolgend die Lösung:

Global Const ToolBarNm = "Business Applications Server - OrderBook " ' Name of the Specific Toolbar


Sub SetupToolbar() ' Create Toolbar. If allready existing, display it.
Dim Nm As Variant, Cnt As Integer
Application.ScreenUpdating = False
On Error Resume Next ' if allready existing
Toolbars(ToolBarNm).Delete
'''On Error GoTo ErrEx ' if allready existing
Toolbars.Add (ToolBarNm): Toolbars(ToolBarNm).Width = 1527
With Application: .ShowToolTips = True: .LargeButtons = False: .ColorButtons = True: End With
With Toolbars(ToolBarNm) 'Define the Toolbar
Cnt = 1 ' The Position-Counter for Buttons. 

Function CreateButton get back the incremented Value
Cnt = CreateButton(42, Cnt, "NewEdit", "Auftrag editieren", "") ' Bleistift
Cnt = CreateButton(0, Cnt, "CopyLine", "Daten Übertragen", "ButCopy") 'Element mit Blatt
Cnt = CreateButton(25, Cnt, "InsertLine", "Neuer Auftrag einfügen", "") 'Blauer Pfeil rechts
Cnt = CreateButton(208, Cnt, "DeleteLine", "Auftrag löschen", "") 'Durchkreuzt
Cnt = CreateButton(3, Cnt, "PrintUsrRange", "Bereich drucken", "") 'Drucker
Cnt = CreateButton(125, Cnt, "DataSheet", "Datenblatt erstellen", "") 'Kamera
Cnt = CreateButton(0, Cnt, "ShiftLeft", "Shift Left", "ButLArr") 'Pfeil links 129
Cnt = CreateButton(0, Cnt, "ShiftRight", "Shift Right", "ButRArr") 'Pfeil rechts 130
Cnt = CreateButton(0, Cnt, "FixCol", "Spalte fixieren", "ButTarget") 'Nagel/Fadenkreuz ButFix
Cnt = CreateButton(0, Cnt, "ShiftUp", "Shift Up", "ButUpArr") ' Empty = 231 shift Up Grafik
Cnt = CreateButton(0, Cnt, "ShiftDown", "Shift Down", "ButDownArr") ' Empty = 231 shift down Grafik
Cnt = CreateButton(205, Cnt, "ShowBook", "OrderBook anzeigen", "") 'Buchrolle
Cnt = CreateButton(38, Cnt, "ShowParam", "Parameter anzeigen", "") 'Dollar
Cnt = CreateButton(243, Cnt, "GetInfo", "Informationen", "ButInfo") 'Informations-"i"
Cnt = CreateButton(0, Cnt, "Restart", "Restart Application", "ButStart ") 'Ampel Grafik
Cnt = CreateButton(0, Cnt, "Services", "Services", "ButServ") 'Schloss 139
Cnt = CreateButton(0, Cnt, "Flash", "Developper Tools", "ButFlash") 'Testprozeduren
Cnt = CreateButton(0, Cnt, "CalcMaster", "Preisliste freigeben", "Objekt 122")
Cnt = CreateButton(0, 1, "", "", "") 'Space (Zwischenräume zählen als Position)
Cnt = CreateButton(0, 7, "", "", "") 'Space
Cnt = CreateButton(0, 13, "", "", "") 'Space
Cnt = CreateButton(0, 19, "", "", "") 'Space
End With
ErrEx:
On Error GoTo 0
With Toolbars(ToolBarNm) ' Positioning an Display
.Width = 600:  .Left = 560:  .Visible = True 'position = xlFloating. .Top = 28: .Position=xlTop
If DialogSheets("DiaServices").OptionButtons("TopOpt").Value = xlOn Then
.Position = xlTop: .Left = 560: .Visible = True
Else  '.OptionButtons("RightOpt").Value = xlOn
.Position = xlRight: .Top = 110: .Visible = True
End If
End With
Application.DisplayStatusBar = True: Application.StatusBar = "Area " & User(Nam): Application.ScreenUpdating = True
End Sub



Sub KillToolbar() ' Delete the Toolbar
On Error Resume Next
Toolbars(ToolBarNm).Delete
End Sub

Anzeige

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Probleme mit einem ADD-IN
10.02.2004 17:44:57
juerg
fogende ergänzung ist übrigens noch nötig..
'----------

Function to Setup one Button or a Space; used by Proc. "SetupToolbar" ---------------
Static 

Function CreateButton(BType As Integer, Pos As Integer, Proc As String, Nm As String, Pict As String) As Integer
With Toolbars(ToolBarNm) 'Add BType-Button at Pos(ition). If Pict is'nt empty then add Empty Button with Picture Pict
If Not Pict Like "" Then BType = 231 'Empty Button    ' To insert a Space, use BType = 0; do it AFTER all Buttons are done
.ToolbarButtons.Add Button:=BType, before:=Pos
If BType > 0 Then
With .ToolbarButtons(Pos): .OnAction = Proc: .StatusBar = Nm: .Name = Nm: End With
End If
End With
CreateButton = Pos + 1 ' Point to the next Position
End Function

Anzeige
;

Forumthreads zu verwandten Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige