Probleme mit einem ADD-IN

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

Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

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

Beliebteste Forumthreads (12 Monate)

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread