Office: Zahl in fortlaufende Nummerierung einfügen

Das passt schon. Dann kannst du das da aber auch weglassen:

If Selection.Cells.Count <> Selection.Information(wdMaximumNumberOfColumns) Then
MsgBox "Bitte zuerst eine ganze Tabellenzeile markieren!"
Exit Sub
End If

 

Hallo Gerhard,

ich möchte mich noch einnmal für deine Unterstützung bedanken. Ganz große Klasse!

Viele Grüße Ulli

 

Hallo Gerhard,

jetzt muss ich doch noch einmal nerven.
Die eingefügten Zahlen in Spalte 1 sollen oben ausgerichtet sein, aktuell sind sie zentriert, d.h. wenn ich die Zeilenhöhe vergrößer sind sie mittig in der Zeile ausgerichtet.
Kann der Code angepasst werden, dass die Zahlen oben ausgerichtet sind?

Viele Grüße Ulli

 

Hallo Ulli,

in der Annahme, dass du so viele Tabellen hast, dass eine händische Einstellung der Ausrichtung via Menüband (Tabellenlayout) zu mühsam ist,
und in der Annahme, dass es in Spalte 1 keine Ausnahme von der Formatierung vertikal oben/horizontal links geben soll, empfehle ich die Holzhammermethode (nachträglich die ganze Spalte neu ausrichten):

tabelle.Columns(1).Select
Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft
Selection.Cells.VerticalAlignment = wdCellAlignVerticalTop

Die drei Zeilen kannst du jeweil direkt über End Sub der fortlNr3 und 4 einfügen.

 

Hallo Gerhard,

Ja, ich habe nicht darauf gachtet wie die zu kopierende Zahl ausgerichtet ist.
Diese war zentriert ausgerichtet und entsprechend wird sie ja auch kopiert.
Jetzt passt alles.

Vielen lieben Dank noch einmal

 

Guten Morgen Gerhard,

noch eine ganz kurze Frage.
Ist es möglich den code so zu verändern, dass die Nummerierung mit "0" beginnt und immer 2 stellig angezeigt wird?
00
01
02
03

Ich habe viel versucht, bekomme ich nicht hin.

Sub NeueNummer()
Dim tabelle As Table
Selection.Rows(1).Select ' nur wenn nicht die ganze Zeile markiert werden soll
'Hinweis und ggf Abbruch
If Selection.Information(wdWithInTable) = False Then
MsgBox "Bitte zuerst eine ganze Tabellenzeile markieren!"
Exit Sub
End If

With Selection
Set tabelle = .Tables(1)

'leere Zellen in der Spalte 2 mit einer fortlaufenen Nummer füllen'
If Len(Selection.Cells(2).Range) = 2 Or _
Selection.Cells(2).Range.Paragraphs(1).Style = "Listenformat" Then

'Laufende Nummern ergänzen bzw. anpassen
Call laufnum2

'Inhalt der ersten Zelle links neben die bearbeitete Zelle kopieren
tabelle.Cell(2, 1).Range.Copy
Selection.Cells(1).Range.Paste
End If
End With
End Sub
Sub laufnum2()
With ListGalleries(wdNumberGallery).ListTemplates(1).ListLevels(1)
.NumberFormat = "%1"
.TrailingCharacter = wdTrailingNone
.NumberStyle = wdListNumberStyleArabic
.NumberPosition = 1
.StartAt = 1
End With
ListGalleries(wdNumberGallery).ListTemplates(1).Name = ""
Selection.Cells(2).Range.ListFormat.ApplyListTemplateWithLevel ListTemplate:= _
ListGalleries(wdNumberGallery).ListTemplates(1), ContinuePreviousList:= _
True, ApplyTo:=wdListApplyToWholeList, DefaultListBehavior:= _
wdWord10ListBehavior

End Sub

Viele Grüße Ulli

 

Hallo Ulli,

ändere in der Sub Laufnum2():
.numberformat = "0%1"
und
.startAt = 0

 

Hallo Gerhard,

vielen Dank!
Geht es auch, dass die vorstehende 0 nur bis 09 ist? aktuell steht sie immer davor, wie z.B. 01, oder 010

d.H.
00
01
02
02
04
05
06
07
08
09
10
11

Viele Grüße Ulli

 

Hallo Ulli,

ja, das war ein nicht überprüfter Schnellschuss. Allerdings hab ich bisher noch nicht rausgefunden, wie man per VBA in den Listgalleries eine korrekte Nummerierung mit vorangestellter Null definiert. Händisch geht es so: Schaltfläche für die Nummerierung, neues Zahlenformat definieren, führende 0 auwählen, fertig. Dieses neue Zahlenformat erscheint dann in der Nummerierungsbibliothek als erste und du könntest dann die Makros wie bisher starten.
Was ich nicht weiß: Ob das neue Zahlenformat ewig an erster Stelle bleibt bzw. wie man das beeinflussen kann. Insofern ist es eine wacklige Geschichte.

Aber ich schlage dir vor, das Gefummel mit den automatischen Listen komplett sein zu lassen und statt dessen eine benutzerdefiniertes Listenformatvorlage zuverwenden. Da hat man ein bisschen Aufwand beim Erstellen aber das Anwenden klappt ohne Zicken.

Das Prinzip geht so:

• Man erstellt erstens eine Absatzformatvorlage, die für nichts anderes gut ist, als das Nummerierungsformat zu "tragen"
• Man erstellt zweitens eine Listenformatvorlage, die alle gewünschten Eigenheiten der Nummerierung enthält.
• Man verbindet drittens die Listenformatvorlage mit der Absatzformatvorlage.

Alle drei Dinge muss man nur einmalig machen.
Die Anwendung ist dann simpel: Einem Absatz (bzw. einer Tabellenzelle) die Absatzformatvorlage zuweisen und schwupps gibt es eine Nummer, die sich automatisch anpasst.

Ich häng dir ein Muster an. In der beginnt die Nummerierung bei 0 und die führende Null gibt es nur bis 9. Aus Auffälligkeitsgründen hab ich sie mal schön rot gemacht. Die Absatzformatvorlage heißt "fuerListeAbNull" und die Listenformatvorlage heißt "ListeAbNull". Aber darum musst du dich nicht kümmern, das erledigen die beiden Makros (eins für die Schleife über Spalte 2, und eins für einzelne Zellen.

Wenn dir das zusagt, erklär ich dir gern die Einzelheiten, und ich benötige noch eine Auskunft:
Handelt es sich nur um 1 Dokument oder um mehrere? Wenn letzteres, müsste ich noch wissen, auf welcher Dokumentvorlage sie beruhen.

 

Hallo Gerhard,

vielen Dank für deinen Einsatz.

Ich habe eigendlich nur ein Masterdatei, aus der sich dann letztendlich viele Protokolldateien entwickeln.
Mit deinen Code's funktioniert es jetzt eigentlich tadellos.
Die fortlaufende Nummer über die Nummerierungsbibliotek hatte ich auch schon angewendet. Aber wenn ich den Code dann aufrufe, ändert sich das wieder in einstellig.

Ich kann auch ohne die vorgesetzte 0 leben, mach dir keine weiter Arbeit.
Falls dir dennoch eine Lösung für den VBA Code einfällt, kannst du mir diesen gerne senden.

Mit den Formatvorlagen werde ich mich auch mal beschäftigen.

Vielen lieben Dank für Alles.

Gruß Ulli

 

Hallo Gerhard,

ich hoffe ich nerve nicht.

Kann der Code noch so angepasst werden, dass der Cursor zum Ende in Spalte 3 steht?
Danke vorab, Gruß Ulli

Sub NeueNummer()
Dim tabelle As Table
Selection.Rows(1).Select ' nur wenn nicht die ganze Zeile markiert werden soll
'Hinweis und ggf Abbruch
If Selection.Information(wdWithInTable) = False Then
MsgBox "Bitte zuerst eine ganze Tabellenzeile markieren!"
Exit Sub
End If

'If Selection.Cells.Count <> Selection.Information(wdMaximumNumberOfColumns) Then '( ganze Zeile markieren)
' MsgBox "Bitte zuerst eine ganze Tabellenzeile markieren!" ( ganze Zeile markieren)
' Exit Sub ( ganze Zeile markieren)
'End If ( ganze Zeile markieren)

With Selection
Set tabelle = .Tables(1)

'leere Zellen in der Spalte 2 mit einer fortlaufenen Nummer füllen'
If Len(Selection.Cells(2).Range) = 2 Or _
Selection.Cells(2).Range.Paragraphs(1).Style = "Listenformat" Then

'Laufende Nummern ergänzen bzw. anpassen
Call laufnum2

'Inhalt der ersten Zelle links neben die bearbeitete Zelle kopieren
tabelle.Cell(2, 1).Range.Copy
Selection.Cells(1).Range.Paste
End If
End With
End Sub
Sub laufnum2()
With ListGalleries(wdNumberGallery).ListTemplates(1).ListLevels(1)
.NumberFormat = "%1"
.TrailingCharacter = wdTrailingNone
.NumberStyle = wdListNumberStyleArabic
.NumberPosition = 1
.StartAt = 0 ' Start mit 1 auf 1 ändern
End With
ListGalleries(wdNumberGallery).ListTemplates(1).Name = ""
Selection.Cells(2).Range.ListFormat.ApplyListTemplateWithLevel ListTemplate:= _
ListGalleries(wdNumberGallery).ListTemplates(1), ContinuePreviousList:= _
True, ApplyTo:=wdListApplyToWholeList, DefaultListBehavior:= _
wdWord10ListBehavior

End Sub

 

Hallo Ulli,

hier ein paar Varianten, je nachdem was du genau haben willst:

Code:

'erste Zelle in Spalte 3 markieren:
tabelle.Cell(1, 3).Select

'oder: letzte Zelle in Spalte 3 markieren:
tabelle.Cell(tabelle.Rows.Count, 3).Select

'falls die angesprungene Zelle schon einen Eintrag hat:

'Schreibmarke vor den Eintrag setzen:
Selection.Collapse direction:=wdCollapseStart

'oder: Schreibmarke hinter den Eintrag setzen:
Selection.Collapse direction:=wdCollapseEnd
Selection.MoveRight unit:=wdCharacter, Count:=-1

In jedem Fall gehören die gewünschten Zeilen direkt oberhalb von End Sub der Prozedur NeueNummer.

Mir fällt übrigens auf, dass du mittels Selection.Rows(1).Select ja schon dafür gesorgt hast, dass auf jeden Fall eine ganze Zeile markiert ist, und trotzdem die Prüfung, ob eine ganze Zeile markiert ist, dringelassen hast. Das schadet nichts, aber nützt auch nichts.

 

Hallo Gerhard,

vielen Dank.
Ich glaube ich hatte mich unklar ausgedrück.

Gewünscht war einfach nur, dass der Cursur in der Zeile, in der das Makro "Sub NeueNummer()" ausgeführt, nach der Prozedur in Spalte 3 steht, also in der aktiven Zeile in Spalte 3
Ist das möglich?

Viele Grüße Ulli

 

Hallo Ulli,

nach dieser Aktion: Selection.Cells(1).Range.Paste steht die Schreibmarke in der ersten Zelle vorher markierten Zeile. Dann bewegst du sie so zwei Zellen weiter: Selection.Move unit:=wdCell, Count:=2

 

Hallo Gerhard,

perfekt !! ganz herzlichen Dank!!
Gruß Ulli