Laufzeitfehler 5
21.07.2005 12:06:23
Jörg
ich habe da wieder mal ein Problem mit einen Macro unter Excel 2003.
Ich möchte hier beim öffnen der Datei die Symbolleisten ausblenden und mache
dies bis Excel 2002 mit folgenden Macro:
Private Sub Workbook_Open()
Dim cb As CommandBar
Dim CBC As CommandBarButton
Dim I%
On Error Resume Next
Set cb = Application.CommandBars.Add(name:="Liste", _
temporary:=True, Position:=msoBarTop)
On Error GoTo 0
If Application.CommandBars("Liste").Visible = False Then
cb.Visible = True
For I = 1 To 11
Set CBC = cb.Controls.Add(Type:=msoControlButton)
With CBC
.Width = 50 ' Breite der Schalter
.Style = msoButtonCaption ' Text auf Schaltfläche
Select Case I
Case 1
.Caption = "Startseite"
.OnAction = "Start"
.TooltipText = "zurück zur Startseite"
Case 2
.Caption = "Standard Geräte"
.OnAction = "Startseite_1"
.TooltipText = "Seriengeräte auswählen"
Case 3
.Caption = "Reset Auswahl"
.OnAction = "Reset_all"
.TooltipText = "Auswahl löschen"
Case 4
.Caption = "Simpati-Daten Import"
.OnAction = "simpati_import"
.TooltipText = "Simpati-Daten einlesen"
Case 5
.Caption = "Schließen"
.OnAction = "schliessen"
.TooltipText = "Datei mit Speichern schließen"
Case 6
.Caption = "Speichern"
.OnAction = "SaveAndClose"
.TooltipText = "Datei nur Speichern"
Case 7
.Caption = "Drucken"
.OnAction = "Druckmenu"
.TooltipText = "Drucken"
Case 8
.Caption = "Kalibrierdaten eingeben"
.OnAction = "Protokoll"
.TooltipText = "Eingabe von Handwerte"
Case 9
.Caption = "Blattschutz"
.OnAction = "Schutz"
.TooltipText = "Blattschutz aufheben/setzen"
Case 10
.Caption = "Formular ändern"
.OnAction = "abfrage_aendern"
.TooltipText = "Startformular ändern"
Case 11
.Caption = " ? "
.OnAction = "Hilfe"
.TooltipText = "Hilfe"
End Select
End With
Next I
End If
Application.CommandBars("Toolbar List").Enabled = False
Application.CommandBars("worksheet menu bar").Enabled = False
Application.CommandBars("Drawing").Enabled = False
Application.CommandBars("Formatting").Enabled = False
Application.CommandBars("Standard").Enabled = False
Application.CommandBars("Formatting").Enabled = False
Application.CommandBars("Chart").Enabled = False
Application.CommandBars("External Data").Enabled = False
Application.CommandBars("Forms").Enabled = False
Application.CommandBars("Picture").Enabled = False
Application.CommandBars("PivotTable").Enabled = False
Application.CommandBars("Control Toolbox").Enabled = False
Application.CommandBars("Reviewing").Enabled = False
Application.CommandBars("Visual Basic").Enabled = False
Application.CommandBars("Web").Enabled = False
Application.CommandBars("WordArt").Enabled = False
Application.CommandBars("Drawing").Enabled = False
Application.CommandBars("Full Screen").Enabled = False
Application.DisplayFullScreen = True
Application.ScreenUpdating = True
On Error Resume Next
ThisWorkbook.Names("OK").Delete
On Error GoTo 0
'Abfrage Datum wenn mehr als 1Jahr dann Userform
If Worksheets("Startseite").Range("B12").Value = Date - 364 Then
If MSGbox("Die Datei ist ein Jahr alt möchten Sie die Daten ändern?", vbYesNo, "Hinweis") = vbYes Then
UserForm1.Show
End If
Else
End If
'Wenn Inhalt dann kein Userform
If Worksheets("Startseite").Range("D8").Value = "" Then
UserForm1.Show
Else:
Exit Sub
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Target.Column > 2 Then Exit Sub
Dim z As Integer
z = Sheets("Ausgabe Wartung").UsedRange.Rows.Count
ActiveSheet.PageSetup.PrintArea = "$A$1:$D$" & z
End Sub
Public Sub Workbook_BeforeClose(Cancel As Boolean)
Dim nme As name
On Error Resume Next
Set nme = ThisWorkbook.Names("OK")
If Err > 0 Or nme Is Nothing Then Cancel = True
On Error Resume Next
Application.CommandBars("Liste").Delete
Application.ScreenUpdating = False
Application.DisplayFullScreen = False
Application.CommandBars("Toolbar List").Enabled = True
Application.CommandBars("worksheet menu bar").Enabled = True
Application.CommandBars.Item("Standard").Visible = True
Application.CommandBars("Formatting").Enabled = True
Application.CommandBars("Drawing").Enabled = True
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Private Sub Workbook_Deactivate()
On Error Resume Next
If Application.CommandBars("Liste").Visible = True Then
Application.CommandBars("Liste").Visible = False
End If
End Sub
Private Sub Workbook_Activate()
On Error GoTo neu
If Application.CommandBars("Liste").Visible = False Then
Application.CommandBars("Liste").Visible = True
End If
Exit Sub
neu:
Workbook_Open
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Excel.Range)
On Error GoTo neu
If Application.CommandBars("Liste").Visible = False Then
Application.CommandBars("Liste").Visible = True
End If
Exit Sub
neu:
Workbook_Open
End Sub
Public Sub Druckmenu()
Druckform.Show
End Sub
Leider habe hier nur Excel 2002 , so das ich das ganze nicht debuggen kann.
Aber evt. kennt jemand von Euch das Problem.
Gruss und vielen Dank Jörg