Navigationsleiste - Eigenbau
23.10.2004 15:10:08
Rolf
da unser geschätzter Hans bisweilen ein wenig knauserig
mit der Freigabe von Kennwörtern ist, habe ich 'mal selbst gebastelt.
Ich wäre sehr dankbar, wenn Ihr euch den Code einmal im Hinblick
darauf anschaut, ob Ihr eine konzeptionelle Alternative seht.
Die Icons sind im Download von Hans' Beispieldatei "xlnavigate.zip"
enthalten.
Herzlich
Rolf
'Navigationsleiste anlegen
'by Rolf Beißner
'erst. 10/2004
Option Explicit
Option Base 1
Public Const fold As Integer = 4 'Anzahl Verzeichnisse
Public Const fil As Integer = 2 'Anz.Dateien je Verzeichnis
Const h As Integer = 25 'Standardhöhe
Const w As Integer = 25 'Standardbreite
Sub start_navig_leiste() 'Startprozedur
Worksheets.Add 'neues Sheet anlegen..
Call fenster_attr 'Fenster definieren
Call anlegen 'Leist anlegen
Call alle 'alle markieren
Call zellabhängigkeit 'Zellabhängigkeit definieren
[a1].Select 'Markierungen aufheben
End Sub
Sub anlegen() 'Navigationsleiste anlegen
Const start As Integer = 80 'Top-Start
Const toffset As Integer = 20 'Top-Offset
Dim ob As Long 'jeweil.oben
Dim i As Integer, j As Integer 'Schleifenzähler
Dim li As Variant 'mögliche left-positions
li = Array(60, 75, 105, 132, 140, 167) 'left-positions
Call gif_einfügen("menu_new_root.gif", li(1), 5, 60, 60) 'Root einfügen
Call gif_einfügen("menu_bar.gif", 68, 60, w, 42) 'senkrechter Strich
ob = start 'top-position
For i = 1 To fold 'Folderschleife
ob = ob + toffset 'top-position
'plus/minus einfügen
Call gif_einfügen("menu_tee_plus.gif", li(2), ob, w, h) 'plus-icon
ActiveSheet.Shapes(Selection.Name).Name = "plus" & i 'plus m.Zähler versehen
Call gif_einfügen("menu_tee_minus.gif", li(2), ob, w, h) 'minus-icon
ActiveSheet.Shapes(Selection.Name).Name = "minus" & i 'minus m.Zähler versehen
'closed/open/Verzeichn.-Bezeichnung einfügen
Call gif_einfügen("menu_folder_closed.gif", li(3), ob, w, h) 'closed-icon
ActiveSheet.Shapes(Selection.Name).Name = "closed" & i 'closed m.Zähler versehen
Call gif_einfügen("menu_folder_open.gif", li(3), ob, w, h) 'open-icon
ActiveSheet.Shapes(Selection.Name).Name = "open" & i 'open m.Zähler versehen
ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, li(5), ob + 5, _
50, 15).Select 'folder-textbox
'Datei-Icons u.-Bezeichnung einfügen
For j = 1 To fil 'Dateien-Schleife
ob = ob + toffset 'top-position
If j = 1 Then
Call gif_einfügen("menu_bar.gif", li(3), ob, w, h) 'senkrechter Strich
Call gif_einfügen("menu_bar.gif", li(2), ob, w, h) 'senkrechter Paralellstrich
ob = ob + h 'top-position
End If
If j < fil Then
Call gif_einfügen("menu_tee.gif", li(3), ob, w, h) 'T-icon
Call gif_einfügen("menu_bar.gif", li(2), ob, w, h) 'senkrechter Paralellstrich
Else
Call gif_einfügen("menu_corner.gif", li(3), ob, w, h) 'corner-icon
Call gif_einfügen("menu_bar.gif", li(2), ob, w, h) 'senkrechter Paralellstrich
Call gif_einfügen("menu_bar.gif", li(2), ob + toffset, w, h) 'senkrechter Paralellstrich
End If
ob = ob + 5 'top-position
Call gif_einfügen("menu_link_default.gif", li(4), ob, w, h) 'sheet-icon
ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, li(6), ob + 5, _
50, 15).Select 'file-textbox
Next
ob = ob + toffset 'top-position
Next
'Abschluss
Call gif_einfügen("menu_bar.gif", li(2), ob, w, h) 'senkrechter Strich
ob = ob + toffset 'top-position
Call gif_einfügen("menu_corner.gif", li(2), ob, w, h) 'corner-icon
Call gif_einfügen("menu_link_default.gif", li(3), ob, w, h) 'sheet-icon
End Sub
Sub gif_einfügen(ByVal bild As String, ByVal links As Long, ByVal oben As Long, ByVal breit, ByVal hoch)
Dim vz As String, nam As String 'Verzeichnis,Dateiname
vz = "C:\xlnavigate\" 'Speicherplatz der icons
ActiveSheet.Pictures.Insert(vz & bild).Select 'icon einfügen
nam = Selection.Name 'Namen ermitteln
With ActiveSheet.Shapes(nam) 'icon-postion definieren
.Left = links
.Top = oben
.Width = breit
.Height = hoch
If bild = "menu_tee_minus.gif" Or bild = "menu_tee_plus.gif" Then 'Makro hinterlegen
.OnAction = "tauschen"
End If
End With
End Sub
Sub alle() 'alle shapes markieren
ActiveSheet.Shapes.SelectAll
End Sub
Sub zellabhängigkeit() 'Zellabhängikeit definieren
With Selection
.Placement = xlMoveAndSize
.PrintObject = True
End With
End Sub
Sub fenster_attr() 'Fenster definieren
Cells.Interior.ColorIndex = 8
With ActiveWindow
.WindowState = xlNormal
.Zoom = 75
.Top = 2
.Left = 2
.Width = 225
.Height = 405
.DisplayGridlines = False
.DisplayHeadings = False
End With
End Sub
'Ereigniscode
Sub tauschen() 'Tauschmakro
Dim actshape As Shape 'Objektvariable
Dim rc As String 'return-code Caller
Dim r As Integer 'Zeilenposition
Dim nr As Integer 'interne Foldernummer
rc = Application.Caller() 'Auslöser ermitteln
Set actshape = ActiveSheet.Shapes(rc) 'auslös.icon als Objektvar.
With actshape
'MsgBox .TopLeftCell.Address
.ZOrder msoSendToBack 'nach hinten
nr = num(.Name) 'interne Foldernummer
r = 11 + (nr - 1) * (2 * fil + 5) 'Zeilenposition ermitteln
If Rows(r + 3).EntireRow.Hidden = True Then 'plus aktiv
Rows(r & ":" & r + fil * 2 + 1).EntireRow.Hidden = False 'Zeilen einblenden
ActiveSheet.Shapes("closed" & nr).ZOrder msoSendToBack 'nach hinten
Else 'minus aktiv
Rows(r & ":" & r + fil * 2 + 1).EntireRow.Hidden = True 'Zeilen ausblenden
ActiveSheet.Shapes("open" & nr).ZOrder msoSendToBack 'nach hinten
End If
End With
End Sub
Function num(nam As String) As Integer 'interne Foldernummer ermitteln
Dim i As Integer
Dim z As String
For i = 1 To Len(nam)
z = Mid(nam, i, 1)
If Asc(z) < 65 Then
num = Right(nam, Len(nam) - i + 1)
Exit For
End If
Next
End Function