Excel vba Tabellen Codenamen erzwingen

[sharky51]

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!?

[LuckyJoe]

Hi,

ja, das sollte funktionieren.

Probiere mal folgende Eigenschaften aus:

- ActiveSheet.Name
- ActiveSheet.CodeName
- ActiveSheet.Index

[RPP63]

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

[RPP63]

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:

[sharky51]

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?

[sharky51]

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?

[schauan]

Hallöchen,

siehe da:

Tabellenausschnitte-und-VBA-Codes-im-Forum-einstellen

der Link unten

[RPP63]

Moin!
Ich hatte den Thread gar nicht mehr auf dem Schirm … 

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.

   

Gruß Ralf

[sharky51]

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!

[RPP63]

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