Office: Zahl in fortlaufende Nummerierung einfügen

Hallo zusammen,

ich habe folgendes Problem.

In einer Word Tabelle habe ich eine fortlaufenden Nummerierung.

Zwischendurch ist eine Zahl in der Reihe (in der Beispieldatei die 10 in Zeile 8)
Ich möchte diese Zahl per VBA in die Reihe eingliedern als nächste fortlaufende Nummer, d.H. es müsste jetzt fortlaufende Nummer 6 werden. Die Formartierung sollte genau wie die vorherige Nummerierung sein, linksbündig.

Ist dies mit einem Makro möglich?

Vielen Dank für eure Hilfe

Viele Grüße Ulli

 

Hallo Ulli,

dein Musterdokument ist komplett leer. Es wäre aber wichtig zu wissen, ob deine "fortlaufende Nummerierung" irgendwas automatisches ist, oder ob du die einfach reingetippt hast, und ob sie in Zeilen oder Spalten stehe. Im günstigsten Fall könntest du sämtliche Nummern aus dem Bereich entfernen, ihn markieren und eine automatische Nummerierung (Gliederung) aus dem Menüband zuweisen. Dass du da ein Makro brauchst, glaub ich erst mal nicht.

Wenn der Tipp dir nichts taugt, lad nochmal ein Musterdokument hoch.

 

Hallo Gehard,

die Nummerierung ist eine fortlaufende, automatische Nummerierung von Word.

Zwischen durch werden schon mal Zeilen gelöscht oder eine Nummerierung entfernt, und dann sollte schon mal, so wie in der Beispieldatei, eine Nummerierung ergänzt werden.
Jetzt der korrekte Anhang

Dadurch, das es teilweise viele Zeilen sind, ist ein manuelles Durchnummerieren sehr aufwendig, besonders weil nicht alle Werte in die Nummerierun einfließen sollen.

Gruß Ulli

 

Hallo Ulli,

versteh ich das richtig:

• Die komplett leeren Zellen (also weder Nummern noch Inhalt) sollen erhalten bleiben und auch keine Nummerierung kriegen
• Die Zellen, die keine Nummerierung haben UND statt dessen irgendeinen Inhalt, sollen statt des Inhalts eine Nummerierung (fortgesetzt) kriegen.
• Die weiter unten vorhandenen Nummern sollen sich anpassen

Wenn ich das richtig interpretiert habe, wende auf dein Musterdokument folgendes Makro an (vorher irgendwo in die Tabelle klicken)

Code:

'Schreibmarke irgendwo in die Tabelle setzen
Sub nummerierung()
Dim tabelle As Table
Dim i As Long

Set tabelle = Selection.Tables(1)

With tabelle
    For i = 1 To .Rows.Count
        If .Cell(i, 1).Range.ListFormat.ListType = 0 And _
            Len(.Cell(i, 1).Range) > 2 Then
          
            .Cell(i, 1).Range.Text = ""
            .Cell(i, 1).Range.ListFormat.ApplyListTemplateWithLevel ListTemplate:= _
            ListGalleries(wdNumberGallery).ListTemplates(1), ContinuePreviousList:= _
            True, ApplyTo:=wdListApplyToWholeList, DefaultListBehavior:= _
            wdWord10ListBehavior
        End If
    Next i
End With
End Sub

Ich hoffe, das funktioniert, denn ich steh mit diesen ListGalleries auf extremem Kriegsfuß.

 

Hallo Gerhard,

das funktioniert, super. Danke !!

Aber für meine Anwendung benötige ich es noch etwas verändert, ich werde mich später gerne noch einmal dazu melden.

Viele Grüße Ulli

 

Hallo Gerhard,

ich habe meinen Wunsch konkretisiert, siehe Beispieldatei.
Ich hoffe dies ist verständlich und umsetzbar.
Vielen Dank für die Unterstützung.

Gruß Ulli

 

Hallo Ulli,

kopiere dieses Makro ins Modul ThisDocument deines Musterdokuments und teste.

Code:

Sub fortlNr_v2()
Dim tabelle As Table
Dim i As Long, laufNr As Long, anzZeilen As Long

'Hinweis und ggf Abbruch
If Selection.Information(wdWithInTable) = False Then
    MsgBox "Bitte zuerst in die zu bearbeitende Tabelle klicken!"
    Exit Sub
End If

Set tabelle = Selection.Tables(1)
anzZeilen = tabelle.Rows.Count
laufNr = 0

With tabelle
    'Tabellenzeilen ab Zeile 2durchschleifen
    For i = 2 To anzZeilen
  
        'leere Zellen in der Spalte 2 mit einer fortlaufenen Nummer füllen'
        If Len(.Cell(i, 2).Range) = 2 Then
            laufNr = laufNr + 1
            .Cell(i, 2).Range = laufNr
            'Inhalt der ersten Zelle links neben die bearbeitete Zelle kopieren
            .Cell(1, 1).Range.Copy
            .Cell(i, 1).Range.Paste
        End If
    Next i
End With
End Sub

Falls es so passt, nicht vergessen, das Dokument im Format *.docm zu speichern (oder, wenn das Original eine Dokumentvorlage (dotx) ist, dann halt als *.dotm).

 

Hallo Gerhard,

super, du bist genial, funktioniert einwandfrei, danke!!

Noch zwei Frage:
Frage1
Wenn ich den Code aufgerufen habe, und ich dann nachher irgendwo noch Zeilen einfüge, und ich den Code dort wiederholt aufrufe, wäre es schön, wenn sich die Nummerierung fortlaufend in die vorherige Nummerierung einfügt (aktuell fängt es dann wieder mit 1 an.

Frage 2
Wie müsste ich den geänderten Code (Frage1) ändern, dass die Eingabe nur in der Zeile erfolgt, in der der Cusor steht?
d.H. wenn ich in der Beispieldatei den Cursor in die Zeile 3 stelle, sollte nach aufrufen dann in der zweiten Spalte die Nr. 1
wenn ich den Cursor dann z.B. in die Zeile 8 Stelle und den Code noch einmal aufrufe, dann sollte dort in Spalte 2 die fortlaufende Nr. 2 stehen.

Danke für deine Hilfe
Gruß Ulli

 

Hallo Ulli,

Zusatzfrage 1 hab ich glaub ich hingekriegt, unter Verwendung der von mir ungeliebten Listgalleries (musst halt mal testen).

Zusatzfrage 2 versteh ich nicht. Die würde doch die eben mühsam erstellte laufende Nummerierung zerstören?
Wenn vorher 1,2,3,4...8 notiert ist sollte denn dann die neue Nummerierung 1,2,1,4...2 lauten? Wenn du das wirklich so meinst, muss ich wahrscheinlich passen, denn das wären quasi 2 ineinander verschachtelte, voneinander unabhängige Listen. Oder soll das ein Makro werden, das auf einen anderen Fall (eine andere Tabelle) angewendet werden soll?

Für die Frage 1 ersetze das bisherige Makro durch diese beiden (beide in ThisDocument kopieren):

Code:

Sub fortlNr_v3()
Dim tabelle As Table
Dim i As Long, laufNr As Long, anzZeilen As Long

'Hinweis und ggf Abbruch
If Selection.Information(wdWithInTable) = False Then
    MsgBox "Bitte zuerst in die zu bearbeitende Tabelle klicken!"
    Exit Sub
End If

Set tabelle = Selection.Tables(1)
anzZeilen = tabelle.Rows.Count
laufNr = 0

With tabelle
    'Tabellenzeilen ab Zeile 2durchschleifen
    For i = 2 To anzZeilen

        'leere Zellen in der Spalte 2 mit einer fortlaufenen Nummer füllen'
        If Len(.Cell(i, 2).Range) = 2 Or _
        .Cell(i, 2).Range.Paragraphs(1).Style = "Listenformat" Then
           
           'Laufende Nummern ergänzen bzw. anpassen
           Call laufNum(i, tabelle)

         
            'Inhalt der ersten Zelle links neben die bearbeitete Zelle kopieren
            .Cell(1, 1).Range.Copy
            .Cell(i, 1).Range.Paste
        End If
    Next i
End With
End Sub

Sub laufNum(j, tabell)

    With ListGalleries(wdNumberGallery).ListTemplates(1).ListLevels(1)
        .NumberFormat = "%1"
        .TrailingCharacter = wdTrailingNone
        .NumberStyle = wdListNumberStyleArabic
        .NumberPosition = 0
        .StartAt = 1
    End With
ListGalleries(wdNumberGallery).ListTemplates(1).Name = ""
tabell.Cell(j, 2).Range.ListFormat.ApplyListTemplateWithLevel ListTemplate:= _
    ListGalleries(wdNumberGallery).ListTemplates(1), ContinuePreviousList:= _
    True, ApplyTo:=wdListApplyToWholeList, DefaultListBehavior:= _
    wdWord10ListBehavior
End Sub

 

Hallo Gerhard,

das funktioniert schon mal super, ganz große Klasse!! herzlichen Dank

Die Frage 2 zielt darauf hin, das nicht alle Zeilen eine Nummerierung bekommen sollen, sonder nur die Zeilen, in der der Cursor steht und das Makro aufgerufen wurde.
d.H. steht der Cursor z.B. in Zeile 3 und ich rufe das Makro auf, wird eine neue Nummerierung erzeugt aber nur in dieser Zeile.
Wenn ich dann den Cursor z.B. in Zeile 8 setze und dort das Makro aufrufe, sollte in der Zeile 8 die Nummerierung fortgesetzt werden (entsprechend die Nummer 2)
Wenn das klappen würde wäre es perfekt

Viele Grüße Ulli