Hallo zusammen,
darf ich wieder einmal um Eure Hilfe bei einem Problem bitten?
Meine Idee ist in einem Workbook, in dem unterschiedlich viele Tabellen vorkommen können, die Code-Namen nach einem bestimmten Kriterium zu ändern.
Bedeutet, ich benenne die Tabellen mit unterschiedlichen Register-Namen und sortiere diese aufsteigend nach den Register-Namen entsprechend in dem Workbook.
Die Code-Namen können somit völlig durcheinander in der Reihenfolge sein, weil auch immer wieder Tabellen gelöscht und neue Tabellen hinzukommen können.
Jetzt die konkrete Frage, ist es möglich per vba die Code-Namen der Tabellen in der Reihenfolge wie sie eingeordnet/sortiert sind aufsteigend umzubenennen?
Also nach Registername TabelleA, TabelleB, TabelleC...den Codenamen dann Tabelle1, Tabelle2, Tabelle3 usw......
Vielleicht könnt Ihr mir da weiterhelfen!?
Hi,
ja, das sollte funktionieren.
Probiere mal folgende Eigenschaften aus:
- ActiveSheet.Name
- ActiveSheet.CodeName
- ActiveSheet.Index
(18.04.2020, 17:34)sharky51 schrieb: [ -> ]Jetzt die konkrete Frage, ist es möglich per vba die Code-Namen der Tabellen in der Reihenfolge wie sie eingeordnet/sortiert sind aufsteigend umzubenennen?
Moin!
Ja das ist möglich!
Ich frage mich allerdings, was der tiefere Sinn dahinter ist.
Geht es Dir um die Übersicht im Projekt-Explorer?
Heißt, Auflistung nach sortiertem .Name?
Anyway:
Der .Index eines Worksheets beginnt immer "links" mit 1
Dies mache ich mir zunutze, um den .CodeName zu ändern.
Damit das Makro nicht in einen Fehler läuft beginnt meine Aufzählung zunächst mit "Tabelle1001"
(die 1000 wird später wieder zurück subtrahiert)
Sub CN_an_Index_anpassen()
' Eventuell "Zugriff auf das VBA-Projektmodell vertrauen"
' im Trustcenter aktivieren
Dim i%
For i = 1 To Worksheets.Count
With Worksheets(i)
.Parent.VBProject.VBComponents(.CodeName).Properties(5) = _
"Tabelle" & CStr(1000 + i)
End With
Next
For i = 1 To Worksheets.Count
With Worksheets(i)
.Parent.VBProject.VBComponents(.CodeName).Properties(5) = _
"Tabelle" & CStr(i)
End With
Next
End Sub
Gruß Ralf
Macht natürlich Sinn, auch das Sortieren der Blätter nach Alphabet gleich zu integrieren:
Sub Name_und_Codename_sortieren()
' Eventuell "Zugriff auf das VBA-Projektmodell Vertrauen"
' im Trustcenter aktivieren
Dim i%, k%
' zunächst nach .Name alphabetisch sortieren
For i = 1 To Worksheets.Count
For k = i To Worksheets.Count
If Worksheets(k).Name < Worksheets(i).Name Then
Worksheets(k).Move Before:=Worksheets(i)
End If
Next
Next
' temporär CodeName ab 1001 beginnend
For i = 1 To Worksheets.Count
With Worksheets(i)
.Parent.VBProject.VBComponents(.CodeName).Properties(5) = _
"Tabelle" & CStr(1000 + i)
End With
Next
' finaler .CodeName
For i = 1 To Worksheets.Count
With Worksheets(i)
.Parent.VBProject.VBComponents(.CodeName).Properties(5) = _
"Tabelle" & CStr(i)
End With
Next
End Sub
… und ich weiß bereits jetzt, dass die Folgefrage ist, was man macht, wenn es mehr als 9 Blätter gibt.
Aber da erwarte ich zunächst ein wenig Eigeninitiative von Sharky!
:21:
Schönen guten morgen Ralf,
zunächst ein großes und fettes Dankeschön!!!
Der vba-Code von Dir funktioniert wie immer bestens, auch bei mehr als neun Tabellenblättern!
Echt super!!!!
Ich habe mir erlaubt noch ein Modul hinzuzufügen, das mir bestimmte Blätter nach der Neubenennung und aufsteigenden Sortierung
noch an eine gewünschte Positionen verschiebt.
Code:
Sub Blaetter_Anordnen()
Dim wksBlatt As Worksheet
Dim x As Integer
Dim Y As Integer
Dim anzSheets
Set wksBlatt = ActiveSheet
anzSheets = ActiveWorkbook.Worksheets.Count
For x = 1 To anzSheets
For Y = x To ActiveWorkbook.Worksheets.Count
If Worksheets(Y).Name < Worksheets(x).Name Then
Worksheets(Y).Move Before:=Worksheets(x)
End If
Next Y
Next x
wksBlatt.Activate
Set wksBlatt = Nothing
'Ausgewählte Blätter verschieben
Sheets("Contents").Move Before:=Sheets(1)
Sheets("Sonstiges").Move after:=Sheets(Sheets.Count)
Sheets("Zusammenfassung").Move after:=Sheets(Sheets.Count)
Sheets("Konfiguration").Move after:=Sheets(Sheets.Count)
Sheets("SaveHistory").Move after:=Sheets(Sheets.Count)
End Sub
Vielen Dank nochmals für Deine Hilfe!
Btw: Welches Tool verwendest Du um den Source-Code mit den Schlüsselwörten farblich so darzustellen?
Schönen guten morgen Ralf,
zunächst ein großes und fettes Dankeschön!!!
Der vba-Code von Dir funktioniert wie immer bestens, auch bei mehr als neun Tabellenblättern!
Echt super!!!!
Ich habe mir erlaubt noch ein Modul hinzuzufügen, das mir bestimmte Blätter nach der Neubenennung und aufsteigenden Sortierung
noch an eine gewünschte Positionen verschiebt.
Code:
Sub Blaetter_Anordnen()
Dim wksBlatt As Worksheet
Dim x As Integer
Dim Y As Integer
Dim anzSheets
Set wksBlatt = ActiveSheet
anzSheets = ActiveWorkbook.Worksheets.Count
For x = 1 To anzSheets
For Y = x To ActiveWorkbook.Worksheets.Count
If Worksheets(Y).Name < Worksheets(x).Name Then
Worksheets(Y).Move Before:=Worksheets(x)
End If
Next Y
Next x
wksBlatt.Activate
Set wksBlatt = Nothing
'Ausgewählte Blätter verschieben
Sheets("Contents").Move Before:=Sheets(1)
Sheets("Sonstiges").Move after:=Sheets(Sheets.Count)
Sheets("Zusammenfassung").Move after:=Sheets(Sheets.Count)
Sheets("Konfiguration").Move after:=Sheets(Sheets.Count)
Sheets("SaveHistory").Move after:=Sheets(Sheets.Count)
End Sub
Vielen Dank nochmals für Deine Hilfe!
Btw: Welches Tool verwendest Du um den Source-Code mit den Schlüsselwörten farblich so darzustellen?
Moin!
Ich hatte den Thread gar nicht mehr auf dem Schirm …
(19.04.2020, 09:03)sharky51 schrieb: [ -> ]Der vba-Code von Dir funktioniert wie immer bestens, auch bei mehr als neun Tabellenblättern!
Nun, bei mehr als 9 Blättern zerreißt es Dir die Sortierreihenfolge im Projektexplorer.
Wenn Dich das nicht stört, ist es ja gut; ich würde das aber anders lösen.
[
attachment=31252]
Gruß Ralf
Danke, werde mir das heute Abend mal ansehen.
Hallo Ralf,
danke für die Rückmeldung!
Und wie würdest DU das lösen?
Bin immer für bessere Lösungen dankbar!
Ich würde eine führende Null nehmen:
' finaler .CodeName
For i = 1 To Worksheets.Count
With Worksheets(i)
.Parent.VBProject.VBComponents(.CodeName).Properties(5) = _
"Tabelle" & Format(i, "00")
End With
Next