Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

MENU+SCHLEIFE

Betrifft: MENU+SCHLEIFE von: MARIO
Geschrieben am: 01.09.2004 22:03:59

Hallo zusammen,

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

  


Betrifft: AW: MENU+SCHLEIFE von: Ramses
Geschrieben am: 01.09.2004 22:37:06

Hallo

probier das mal

Option Explicit

Const verz = "c:\temp\"

Sub Diverses()
Dim i As Byte
Dim t As Object
Dim a As Integer
Dim Buchst As String, Datei As String
ChDir verz
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"
        Datei = Dir(verz & "*.xls")
        Do While Datei <> ""
            With .Controls.Add
                .BeginGroup = True
                .Caption = Datei
                'Makro mit Übergabe Parameter
                .OnAction = "myFileOpen(""" & Datei & """)"
            End With
            'Datei auf hidden setzen
            SetAttr Datei, vbHidden
            Datei = Dir()
        Loop
    End With
    With .Controls.Add
        .BeginGroup = True
        .FaceId = 161
        .Caption = "Januar"
    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
    End With
    With .Controls.Add '(Type:=msoControlPopup)
        .BeginGroup = True  'Trennlinie
        .FaceId = 169
        .Caption = "Monatssollzeit"
        .OnAction = "Blattschutzi"
    End With
End With
End Sub


Sub myFileOpen(fileN As String)
'gibt den Namen der Datei an wie sie geschrieben wurde
MsgBox fileN
'Würde die DAtei öffnen
Workbooks.Open verz & Fname
End Sub


Gruss Rainer


  


Betrifft: AW: MENU+SCHLEIFE von: MARIO
Geschrieben am: 01.09.2004 23:22:06

Hallo Rainer

habe deinen Code angepasst und ausprobiert.
Funktioniert bestens aber wie kann ich
'Datei auf hidden setzen
SetAttr Datei, vbHidden
Datei = Dir()
am Anfang des Codes auf false setzen .Da ich noch eine Schaltfläche einbauen
will die dann alles aktualisiert.

Gruss Mario


  


Betrifft: AW: MENU+SCHLEIFE von: Ramses
Geschrieben am: 02.09.2004 10:51:31

Hallo

was meinst du damit ?

"...Da ich noch eine Schaltfläche einbauen will die dann alles aktualisiert..."

Und warum dürfen die Dateien nun nicht auf unsichtbar stehen ?

Gruss Rainer


  


Betrifft: AW: MENU+SCHLEIFE von: MARIO
Geschrieben am: 02.09.2004 10:50:41

Hallo zusammen

habe obiges Makro von Rainer heute noch einmal ausprobiert und
festgestellt das beim Anklicken der Schaltflächen
eine Fehlehrmeldung erscheint.
Exel kann das Makro 'myFileOpen("Mappe_1_2004.xls")'nicht finden! usw.
Wo liegt der Fehler oder was mach ich falsch?
Ausserdem werden die Dateien nur ausgelesen wenn sie auf vbnormal stehen.
Wie kann mann die Dateiattribute am Anfang des Ccodes auf vbnormal setzen ?

Gruss mario


  


Betrifft: AW: MENU+SCHLEIFE von: MARIO
Geschrieben am: 02.09.2004 11:13:54

Hallo zusammen, hallo Rainer

durch diese Schaltfläche "Aktuallisieren" soll das Makro "Diverses" wiedergestartet werden. Da dem Ordner ständig neue Dateien zugefügt werden.
Die Dateien werden aber nur augelesen wenn sie auf vbnormal stehen.
Es sollte sollte so sein am Anfang des Codes vbNormal am Schluss vbhidden
Alles klar ?

Vielen dank schon zum Voraus

Gruss MARIO


  


Betrifft: AW: MENU+SCHLEIFE von: MARIO
Geschrieben am: 02.09.2004 14:48:12

Hallo zusammen

vielleicht ist mein Beitrag im Forum untergegangen unter
all diesen Fragen.
Wer kann mir helfen.

Gruss Mario


  


Betrifft: AW: MENU+SCHLEIFE von: Ramses
Geschrieben am: 02.09.2004 16:41:36

Hallo

ich bitte um Entschuldigung dass ich auch noch meine eigene Arbeit machen muss ;-)

Ein bischen wirr das ganze was du haben willst.

"...Es sollte sollte so sein am Anfang des Codes vbNormal am Schluss vbhidden..."

Woher soll ich wissen wann der Anfang ist und wann Schluss ?
Wenn alle auf vbHidden stehen, wann sollen die dann wieder sichtbar sein ?

Gruss Rainer


  


Betrifft: AW: MENU+SCHLEIFE von: MARIO
Geschrieben am: 02.09.2004 17:24:50

Hallo Rainer

sorry ich will natürlich niemanden stressen.
Also ich probiers nochmals zu erklären.
Dein code ist ok, aber wenn neue Dateien in dem Ordner
eingefügt werden und ich den Code laufen lasse
bleibt das popupmenü leer. Sobald ich alle Dateien wieder
auf vbnormal setze funktioniert alles wieder, das popupmenu füllt sich wieder.
Also wenn ich dein Code laufen lasse,sollten alle
Dateien auch die vbhidden Dateien aufgeführt werden, bleibt aber leer.
Beim Anklicken der schaltflächen erscheint eine Fehlehrmeldung
Exel kann das Makro 'myFileOpen("Mappe_1_2004.xls")'nicht finden! usw.
Ich kann die gewünschten Dateien nicht öffnen.
Wo liegt der Fehler oder was mach ich falsch?
Wirklich vielen Dank für deine Bemühungen, ist ja nicht so selbstverständlich.
Ich kann leider erst am Samstag-oder Sonntagabend wieder ins Internet,weil
ich an ein Seminar gehen muss.
Ich hoffe das ich mich verständlich ausgedrückt habe.
Nur zum besseren verständnis
folgender Code für die Tabellenblätter.
Ich möchte das gleiche aber statt Tabellen Dateien öffnen und das im popupmenü.

Sub TabellenImMenue()
  Dim i As Byte
  Dim t As Object
  Dim a As Integer
  Dim Buchst As String
  On Error Resume Next
  Application.CommandBars.ActiveMenuBar.Controls("Tabelle auswählen").Delete
  With Application.CommandBars.ActiveMenuBar.Controls.Add _
                      (Type:=msoControlPopup)
    .Caption = "Tabelle auswählen"
      For i = 1 To Worksheets.Count
        If Worksheets(i).Visible = False Then
       i = i + 1
       End If
      With .Controls.Add '(Type:=msoControlPopup)
        .BeginGroup = True  'Trennlinie
        .Caption = Worksheets(i).Name
        .OnAction = "Waehlen" & i
         End With
         'Loop
        Next i
        With .Controls.Add
      .BeginGroup = True  'Trennlinie
      .FaceId = 161
      .Caption = "Menü aktualisieren"
      .OnAction = "TabellenImMenue"
    End With
  End With
End Sub

Gruss Mario