AW: Auto Open -> Excel/Datei wieder Schliessen
25.02.2010 09:06:24
xr8k2
Hallo Matthias,
ich hab mal in deinem Code ein wenig in den Zeilen für die Fenstererstellung und Positionierung drinrumgeschustert. Schau´s dir mal an ... m.E. dürfte es so kein Problem mit anderen geöffneten Mappen geben.
Sub Fenster_einrichten(Direkt)
Dim WSheet As Worksheet
Dim Max, Blatt, Name, i
Dim Grunddaten As Window, Uebersicht As Window, Chronologie As Window
On Error GoTo Error
Select Case Direkt
Case "cmd_Öffnen_Neu"
ThisWorkbook.Windows(1).Visible = True
Unload form_ÖFFNEN
End Select
' ------------------------------------------------------------------------------------------ _
-- _
' Fenster erstellen und anordnen
' ------------------------------------------------------------------------------------------ _
-- _
Set Grunddaten = ThisWorkbook.Windows(1)
Set Uebersicht = Grunddaten.NewWindow
Set Chronologie = Grunddaten.NewWindow
ThisWorkbook.Windows.Arrange ArrangeStyle:=xlVertical
' ------------------------------------------------------------------------------------------ _
-- _
' Einstellungen am Fenster (Grunddaten)
' ------------------------------------------------------------------------------------------ _
-- _
With Grunddaten
.Caption = "Grunddaten"
.DisplayHeadings = False
.DisplayHorizontalScrollBar = False
.DisplayVerticalScrollBar = False
.DisplayWorkbookTabs = False
.Top = 0
.Left = 0
.Width = 313
.Height = 565
End With
' ------------------------------------------------------------------------------------------ _
-- _
' Einstellungen am Fenster (Übersicht)
' ------------------------------------------------------------------------------------------ _
-- _
With Uebersicht
.Caption = "Übersicht"
.DisplayHeadings = False
.DisplayHorizontalScrollBar = False
.DisplayVerticalScrollBar = False
.DisplayWorkbookTabs = False
.Top = 0
.Left = 306
.Width = 658
.Height = 190
End With
' ------------------------------------------------------------------------------------------ _
-- _
' Einstellungen am Fenster (Chronologie)
' ------------------------------------------------------------------------------------------ _
-- _
With Chronologie
.Caption = "Chronologie"
.DisplayHeadings = False
.DisplayHorizontalScrollBar = False
.DisplayVerticalScrollBar = False
.DisplayWorkbookTabs = False
.Top = 183
.Left = 306
.Width = 658
.Height = 382
End With
' ------------------------------------------------------------------------------------------ _
-- _
' Alle notwendigen Zellen zum Überschreiben freigeben
' ------------------------------------------------------------------------------------------ _
-- _
'Zellen freigeben
Workbooks("Tool.xlsm").Activate
Worksheets("Code").Activate
Range("daten_tabelle").Cells(1, 1).Select
Range(Selection, Selection.End(xlDown)).Select
Max = Selection.Rows.Count
For i = 1 To Max
Blatt = Workbooks("Tool.xlsm").Worksheets("Code").Range("daten_tabelle").Cells(i, 1). _
_
Value
Name = Workbooks("Tool.xlsm").Worksheets("Code").Range("daten_tabelle").Cells(i, 2). _
_
Value
Workbooks("Tool.xlsm").Worksheets(Blatt).Range(Name).Locked = False
Next i
'Namen freigeben
Workbooks("Tool.xlsm").Worksheets("Code").Range("daten_tabelle").Locked = False
' ------------------------------------------------------------------------------------------ _
-- _
' Alle Fenster und Blätter schützen
' ------------------------------------------------------------------------------------------ _
-- _
Thisworbook.Protect Structure:=True, Windows:=True
For Each WSheet In Thisworbook.Worksheets
If WSheet.Name "Code" Then
WSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True, AllowInsertingHyperlinks:=True
WSheet.EnableSelection = xlUnlockedCells
End If
Next WSheet
' ------------------------------------------------------------------------------------------ _
-- _
' "Start-Zelle" anwählen
' ------------------------------------------------------------------------------------------ _
-- _
Grunddaten.Activate
Worksheets("Grund").Activate
Range("E12").Select
Exit Sub
Error:
MsgBox ("Es ist ein Fehler aufgetreten." & vbNewLine & vbNewLine & _
"Hinweis:" & vbNewLine & "F001")
End Sub
Gruß,
xr8k2
PS: Ach ja ... ich arbeite mit Excel2003 wie sich das in 2007 verhält kann ich leider nicht testen.