MENU+SCHLEIFE
01.09.2004 22:03:59
MARIO
mit folgedem Code habe ich neues Menü erstellt.
In diesem Menu ist ein Untermenu. In diesem möchte
ich die Dateien eines Ordners auslesen und neue Schaltflächen
einfügen die dann die Datei öffnet durch ein Makro oder Hyperlink.
Wie muss ich den Code abändern damit ich zum Ziel komme.
Ausserdem möchte ich alle Datei in diesem Ordner die Dateiattribute
auf vbhidden setzen.
Vielen Dank schon zum Voraus.
Gruss Mario
Sub Diverses()
Dim i As Byte
Dim t As Object
Dim a As Integer
Dim Buchst As String
Const verz = "D:\Eigene Dateien\Unsichtbar\"
ChDir verz
With Application.FileSearch
.NewSearch
.LookIn = verz
.FileType = msoFileTypeExcelWorkbooks
.Execute
'End With ' range("A1").Select
On Error Resume Next
Application.CommandBars.ActiveMenuBar.Controls("Diverse Funktionen").Delete
With Application.CommandBars.ActiveMenuBar.Controls.Add _
(Type:=msoControlPopup)
.Caption = "Diverse Funktionen"
With .Controls.Add(Type:=msoControlPopup)
.BeginGroup = True
.Caption = "Archivierte Mappen"
For i = 1 To Application.FileSearch.FoundFiles.Count
' For i = 1 To 12
With .Controls.Add
.BeginGroup = True
.Caption = Workbooks(i).Name
.OnAction = "Waehlen" & i
End With
'End With
Next i
With .Controls.Add
.BeginGroup = True
.FaceId = 161
.Caption = "Januar"
End With
End With
With .Controls.Add(Type:=msoControlPopup)
.BeginGroup = True 'Trennlinie
.FaceId = 161
.Caption = "Manuell speichern & Monatssollzeit"
With .Controls.Add '(Type:=msoControlPopup)
.BeginGroup = True 'Trennlinie
.FaceId = 271
.Caption = "Monatlich manuell speichern "
.OnAction = "Show"
End With
With .Controls.Add '(Type:=msoControlPopup)
.BeginGroup = True 'Trennlinie
.FaceId = 169
.Caption = "Monatssollzeit"
.OnAction = "Blattschutzi"
End With
End With
End With
End With
End Sub