VBA: Registerlasche

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

hallo ernst,
im prinzip so:
in DieseArbeitsmappe


Private Sub Workbook_BeforeClose(Cancel As Boolean)
NameBeimSchliessen
End Sub


Private Sub Workbook_Open()
NameBeimOeffnen
End Sub

in Modul
Public a(), i%
Sub NameBeimOeffnen()
'einlesen aller blattnamen
ReDim a(1 To Sheets.Count)
i = 0
Application.ScreenUpdating = False
For Each namen In Sheets()
i = i + 1
Sheets(i).Activate
a(i) = ActiveSheet.Name
Next
Application.ScreenUpdating = True
End Sub

Sub NameBeimSchliessen()
'rueckschreiben der blattnamen vom oeffnen
'achtung - funktioniert nur, wenn reihenfolge nicht
'geaendert und kein blatt geloescht wurde!
Dim j%
For j = 1 To i
Application.ScreenUpdating = False
Sheets(j).Activate
ActiveSheet.Name = a(j)
Next
Application.ScreenUpdating = True
ActiveWorkbook.Save
End Sub

Sub NameBeimSchliessen() 'rueckschreiben der blattnamen vom oeffnen 'achtung - funktioniert nur, wenn reihenfolge nicht 'geaendert und kein blatt geloescht wurde! i = 0 For Each namen In Sheets() i = i + 1 namen.Name = a(i) Next ActiveWorkbook.Save End Sub

hallo ernst,
du machst ja arbeit ...
'************************************************************
'in diesearbeitsmappe:


Private Sub Workbook_BeforeClose(Cancel As Boolean)
NameBeimSchliessen
End Sub


Private Sub Workbook_Open()
NameBeimOeffnen
End Sub


Private Sub Workbook_SheetActivate(ByVal Sh As Object)
NameBeimWechseln
End Sub


Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
NameBeimWechseln
End Sub


Private Sub Workbook_WindowDeactivate(ByVal Wn As Window)
NameBeimWechseln
End Sub

'************************************************************
'in ein modul:
Option Explicit
Public a(), i%, wieviele%, noch%
Sub NameBeimOeffnen()
'
'programmiert von andre schau am 11.01.04
'einschränkung: von den ersten 4 blättern darf keines gelöscht werden
'die blatteihenfolge ergibt ansonsten sich aus der reihenfolge beim öffnen
'
Dim j%, namen
wieviele = Sheets.Count
'die nächste bedingung kommt wegen der gewünschten begrenzung auf die
'erste 4 blätter und findet sich noch öfter im code
If wieviele > 4 Then wieviele = 4
ReDim a(1 To wieviele, 1 To 3)
i = 0
For Each namen In Sheets()
i = i + 1
If i > 4 Then Exit Sub 'wieder die 4
a(i, 1) = namen.Name
a(i, 2) = namen.Index
'item feststellen - wird benötigt, da sheets(1) sich auf die blattliste der
'ansicht bezieht und nicht auf die reihenfolge im vbproject
For j = 1 To ThisWorkbook.VBProject.VBComponents.Count
If ThisWorkbook.VBProject.VBComponents.Item(j).Type = 100 And _
Left(ThisWorkbook.VBProject.VBComponents.Item(j).Name, 3) = "Tab" Then
If Sheets(i).Name = ThisWorkbook.VBProject.VBComponents.Item(j).Properties.Item("Name") Then
a(i, 3) = ThisWorkbook.VBProject.VBComponents.Item(j).Name
End If
End If
Next
Next
End Sub

Sub NameBeimSchliessen()
Dim namen
i = 1
If Sheets(1).Name <> a(1, 1) Then
Sheets(a(1, 1)).Move before:=Sheets(1)
End If
If UBound(a()) > 1 Then
For i = 2 To UBound(a())
Sheets(a(i, 1)).Move after:=Sheets(i - 1)
Next
End If
ActiveWorkbook.Save
End Sub

Sub NameBeimWechseln()
Dim k%, j%
'dieses if verhindert die ausführung dieses sub beim anlegen
'oder löschen neuer blätter
If Sheets.Count <> wieviele Then
noch = noch + 1
If noch = 1 Then
noch = 0
wieviele = Sheets.Count
End If
Exit Sub
End If
'hier wird beim aktivieren oder deaktivieren des blattes oder
'dem deaktivieren der mappe der alte blattname gesetzt
For j = 1 To ThisWorkbook.VBProject.VBComponents.Count
If ThisWorkbook.VBProject.VBComponents.Item(j).Type = 100 And _
Left(ThisWorkbook.VBProject.VBComponents.Item(j).Name, 3) = "Tab" Then
For k = 1 To UBound(a())
If a(k, 3) = ThisWorkbook.VBProject.VBComponents.Item(j).Name Then
ThisWorkbook.VBProject.VBComponents.Item(j).Properties.Item("Name") = a(k, 1)
End If
Next
End If
Next
End Sub

'************************************************************
Beispielmappe:
https://www.herber.de/bbs/user/2864.xls
gruss andre

Beliebteste Forumthreads (12 Monate)

14 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

14
Beiträge zum Forumthread

Beiträge zu diesem Forumthread